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>.
23 #include "LinkerInternals.h"
28 #ifdef HAVE_SYS_TYPES_H
29 #include <sys/types.h>
35 #ifdef HAVE_SYS_STAT_H
39 #if defined(HAVE_FRAMEWORK_HASKELLSUPPORT)
40 #include <HaskellSupport/dlfcn.h>
41 #elif defined(HAVE_DLFCN_H)
45 #if defined(cygwin32_TARGET_OS)
50 #ifdef HAVE_SYS_TIME_H
54 #include <sys/fcntl.h>
55 #include <sys/termios.h>
56 #include <sys/utime.h>
57 #include <sys/utsname.h>
61 #if defined(ia64_TARGET_ARCH) || defined(openbsd_TARGET_OS)
66 #if defined(openbsd_TARGET_OS)
74 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS) || defined(openbsd_TARGET_OS)
75 # define OBJFORMAT_ELF
76 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
77 # define OBJFORMAT_PEi386
80 #elif defined(darwin_TARGET_OS)
81 # include <mach-o/ppc/reloc.h>
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>
89 /* Hash table mapping symbol names to Symbol */
90 static /*Str*/HashTable *symhash;
92 /* List of currently loaded objects */
93 ObjectCode *objects = NULL; /* initially empty */
95 #if defined(OBJFORMAT_ELF)
96 static int ocVerifyImage_ELF ( ObjectCode* oc );
97 static int ocGetNames_ELF ( ObjectCode* oc );
98 static int ocResolve_ELF ( ObjectCode* oc );
99 #if defined(powerpc_TARGET_ARCH)
100 static int ocAllocateJumpIslands_ELF ( ObjectCode* oc );
102 #elif defined(OBJFORMAT_PEi386)
103 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
104 static int ocGetNames_PEi386 ( ObjectCode* oc );
105 static int ocResolve_PEi386 ( ObjectCode* oc );
106 #elif defined(OBJFORMAT_MACHO)
107 static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
108 static int ocVerifyImage_MachO ( ObjectCode* oc );
109 static int ocGetNames_MachO ( ObjectCode* oc );
110 static int ocResolve_MachO ( ObjectCode* oc );
112 static void machoInitSymbolsWithoutUnderscore( void );
115 /* -----------------------------------------------------------------------------
116 * Built-in symbols from the RTS
119 typedef struct _RtsSymbolVal {
126 #define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
128 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
129 SymX(makeStableNamezh_fast) \
130 SymX(finalizzeWeakzh_fast)
132 /* These are not available in GUM!!! -- HWL */
133 #define Maybe_ForeignObj
134 #define Maybe_Stable_Names
137 #if !defined (mingw32_TARGET_OS)
138 #define RTS_POSIX_ONLY_SYMBOLS \
139 SymX(stg_sig_install) \
143 #if defined (cygwin32_TARGET_OS)
144 #define RTS_MINGW_ONLY_SYMBOLS /**/
145 /* Don't have the ability to read import libs / archives, so
146 * we have to stupidly list a lot of what libcygwin.a
149 #define RTS_CYGWIN_ONLY_SYMBOLS \
227 #elif !defined(mingw32_TARGET_OS)
228 #define RTS_MINGW_ONLY_SYMBOLS /**/
229 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
230 #else /* defined(mingw32_TARGET_OS) */
231 #define RTS_POSIX_ONLY_SYMBOLS /**/
232 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
234 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
236 #define RTS_MINGW_EXTRA_SYMS \
237 Sym(_imp____mb_cur_max) \
240 #define RTS_MINGW_EXTRA_SYMS
243 /* These are statically linked from the mingw libraries into the ghc
244 executable, so we have to employ this hack. */
245 #define RTS_MINGW_ONLY_SYMBOLS \
246 SymX(asyncReadzh_fast) \
247 SymX(asyncWritezh_fast) \
248 SymX(asyncDoProczh_fast) \
260 SymX(getservbyname) \
261 SymX(getservbyport) \
262 SymX(getprotobynumber) \
263 SymX(getprotobyname) \
264 SymX(gethostbyname) \
265 SymX(gethostbyaddr) \
299 SymX(stg_InstallConsoleEvent) \
301 Sym(_imp___timezone) \
309 RTS_MINGW_EXTRA_SYMS \
314 # define MAIN_CAP_SYM SymX(MainCapability)
316 # define MAIN_CAP_SYM
319 #ifdef TABLES_NEXT_TO_CODE
320 #define RTS_RET_SYMBOLS /* nothing */
322 #define RTS_RET_SYMBOLS \
323 SymX(stg_enter_ret) \
324 SymX(stg_gc_fun_ret) \
332 SymX(stg_ap_pv_ret) \
333 SymX(stg_ap_pp_ret) \
334 SymX(stg_ap_ppv_ret) \
335 SymX(stg_ap_ppp_ret) \
336 SymX(stg_ap_pppv_ret) \
337 SymX(stg_ap_pppp_ret) \
338 SymX(stg_ap_ppppp_ret) \
339 SymX(stg_ap_pppppp_ret)
342 #define RTS_SYMBOLS \
346 SymX(stg_enter_info) \
347 SymX(stg_gc_void_info) \
348 SymX(__stg_gc_enter_1) \
349 SymX(stg_gc_noregs) \
350 SymX(stg_gc_unpt_r1_info) \
351 SymX(stg_gc_unpt_r1) \
352 SymX(stg_gc_unbx_r1_info) \
353 SymX(stg_gc_unbx_r1) \
354 SymX(stg_gc_f1_info) \
356 SymX(stg_gc_d1_info) \
358 SymX(stg_gc_l1_info) \
361 SymX(stg_gc_fun_info) \
363 SymX(stg_gc_gen_info) \
364 SymX(stg_gc_gen_hp) \
366 SymX(stg_gen_yield) \
367 SymX(stg_yield_noregs) \
368 SymX(stg_yield_to_interpreter) \
369 SymX(stg_gen_block) \
370 SymX(stg_block_noregs) \
372 SymX(stg_block_takemvar) \
373 SymX(stg_block_putmvar) \
374 SymX(stg_seq_frame_info) \
376 SymX(MallocFailHook) \
378 SymX(OutOfHeapHook) \
379 SymX(StackOverflowHook) \
380 SymX(__encodeDouble) \
381 SymX(__encodeFloat) \
385 SymX(__gmpz_cmp_si) \
386 SymX(__gmpz_cmp_ui) \
387 SymX(__gmpz_get_si) \
388 SymX(__gmpz_get_ui) \
389 SymX(__int_encodeDouble) \
390 SymX(__int_encodeFloat) \
391 SymX(andIntegerzh_fast) \
392 SymX(atomicallyzh_fast) \
394 SymX(blockAsyncExceptionszh_fast) \
396 SymX(catchRetryzh_fast) \
397 SymX(catchSTMzh_fast) \
398 SymX(closure_flags) \
400 SymX(cmpIntegerzh_fast) \
401 SymX(cmpIntegerIntzh_fast) \
402 SymX(complementIntegerzh_fast) \
403 SymX(createAdjustor) \
404 SymX(decodeDoublezh_fast) \
405 SymX(decodeFloatzh_fast) \
408 SymX(deRefWeakzh_fast) \
409 SymX(deRefStablePtrzh_fast) \
410 SymX(divExactIntegerzh_fast) \
411 SymX(divModIntegerzh_fast) \
414 SymX(forkOS_createThread) \
415 SymX(freeHaskellFunctionPtr) \
416 SymX(freeStablePtr) \
417 SymX(gcdIntegerzh_fast) \
418 SymX(gcdIntegerIntzh_fast) \
419 SymX(gcdIntzh_fast) \
425 SymX(int2Integerzh_fast) \
426 SymX(integer2Intzh_fast) \
427 SymX(integer2Wordzh_fast) \
428 SymX(isCurrentThreadBoundzh_fast) \
429 SymX(isDoubleDenormalized) \
430 SymX(isDoubleInfinite) \
432 SymX(isDoubleNegativeZero) \
433 SymX(isEmptyMVarzh_fast) \
434 SymX(isFloatDenormalized) \
435 SymX(isFloatInfinite) \
437 SymX(isFloatNegativeZero) \
438 SymX(killThreadzh_fast) \
441 SymX(makeStablePtrzh_fast) \
442 SymX(minusIntegerzh_fast) \
443 SymX(mkApUpd0zh_fast) \
444 SymX(myThreadIdzh_fast) \
445 SymX(labelThreadzh_fast) \
446 SymX(newArrayzh_fast) \
447 SymX(newBCOzh_fast) \
448 SymX(newByteArrayzh_fast) \
449 SymX_redirect(newCAF, newDynCAF) \
450 SymX(newMVarzh_fast) \
451 SymX(newMutVarzh_fast) \
452 SymX(newTVarzh_fast) \
453 SymX(atomicModifyMutVarzh_fast) \
454 SymX(newPinnedByteArrayzh_fast) \
455 SymX(orIntegerzh_fast) \
457 SymX(performMajorGC) \
458 SymX(plusIntegerzh_fast) \
461 SymX(putMVarzh_fast) \
462 SymX(quotIntegerzh_fast) \
463 SymX(quotRemIntegerzh_fast) \
465 SymX(raiseIOzh_fast) \
466 SymX(readTVarzh_fast) \
467 SymX(remIntegerzh_fast) \
468 SymX(resetNonBlockingFd) \
473 SymX(rts_checkSchedStatus) \
476 SymX(rts_evalLazyIO) \
477 SymX(rts_evalStableIO) \
481 SymX(rts_getDouble) \
486 SymX(rts_getFunPtr) \
487 SymX(rts_getStablePtr) \
488 SymX(rts_getThreadId) \
490 SymX(rts_getWord32) \
503 SymX(rts_mkStablePtr) \
511 SymX(rtsSupportsBoundThreads) \
513 SymX(__hscore_get_saved_termios) \
514 SymX(__hscore_set_saved_termios) \
516 SymX(startupHaskell) \
517 SymX(shutdownHaskell) \
518 SymX(shutdownHaskellAndExit) \
519 SymX(stable_ptr_table) \
520 SymX(stackOverflow) \
521 SymX(stg_CAF_BLACKHOLE_info) \
522 SymX(stg_BLACKHOLE_BQ_info) \
523 SymX(awakenBlockedQueue) \
524 SymX(stg_CHARLIKE_closure) \
525 SymX(stg_EMPTY_MVAR_info) \
526 SymX(stg_IND_STATIC_info) \
527 SymX(stg_INTLIKE_closure) \
528 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
529 SymX(stg_WEAK_info) \
530 SymX(stg_ap_0_info) \
531 SymX(stg_ap_v_info) \
532 SymX(stg_ap_f_info) \
533 SymX(stg_ap_d_info) \
534 SymX(stg_ap_l_info) \
535 SymX(stg_ap_n_info) \
536 SymX(stg_ap_p_info) \
537 SymX(stg_ap_pv_info) \
538 SymX(stg_ap_pp_info) \
539 SymX(stg_ap_ppv_info) \
540 SymX(stg_ap_ppp_info) \
541 SymX(stg_ap_pppv_info) \
542 SymX(stg_ap_pppp_info) \
543 SymX(stg_ap_ppppp_info) \
544 SymX(stg_ap_pppppp_info) \
545 SymX(stg_ap_1_upd_info) \
546 SymX(stg_ap_2_upd_info) \
547 SymX(stg_ap_3_upd_info) \
548 SymX(stg_ap_4_upd_info) \
549 SymX(stg_ap_5_upd_info) \
550 SymX(stg_ap_6_upd_info) \
551 SymX(stg_ap_7_upd_info) \
553 SymX(stg_sel_0_upd_info) \
554 SymX(stg_sel_10_upd_info) \
555 SymX(stg_sel_11_upd_info) \
556 SymX(stg_sel_12_upd_info) \
557 SymX(stg_sel_13_upd_info) \
558 SymX(stg_sel_14_upd_info) \
559 SymX(stg_sel_15_upd_info) \
560 SymX(stg_sel_1_upd_info) \
561 SymX(stg_sel_2_upd_info) \
562 SymX(stg_sel_3_upd_info) \
563 SymX(stg_sel_4_upd_info) \
564 SymX(stg_sel_5_upd_info) \
565 SymX(stg_sel_6_upd_info) \
566 SymX(stg_sel_7_upd_info) \
567 SymX(stg_sel_8_upd_info) \
568 SymX(stg_sel_9_upd_info) \
569 SymX(stg_upd_frame_info) \
570 SymX(suspendThread) \
571 SymX(takeMVarzh_fast) \
572 SymX(timesIntegerzh_fast) \
573 SymX(tryPutMVarzh_fast) \
574 SymX(tryTakeMVarzh_fast) \
575 SymX(unblockAsyncExceptionszh_fast) \
577 SymX(unsafeThawArrayzh_fast) \
578 SymX(waitReadzh_fast) \
579 SymX(waitWritezh_fast) \
580 SymX(word2Integerzh_fast) \
581 SymX(writeTVarzh_fast) \
582 SymX(xorIntegerzh_fast) \
585 #ifdef SUPPORT_LONG_LONGS
586 #define RTS_LONG_LONG_SYMS \
587 SymX(int64ToIntegerzh_fast) \
588 SymX(word64ToIntegerzh_fast)
590 #define RTS_LONG_LONG_SYMS /* nothing */
593 // 64-bit support functions in libgcc.a
594 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
595 #define RTS_LIBGCC_SYMBOLS \
604 #elif defined(ia64_TARGET_ARCH)
605 #define RTS_LIBGCC_SYMBOLS \
613 #define RTS_LIBGCC_SYMBOLS
616 #ifdef darwin_TARGET_OS
617 // Symbols that don't have a leading underscore
618 // on Mac OS X. They have to receive special treatment,
619 // see machoInitSymbolsWithoutUnderscore()
620 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
625 /* entirely bogus claims about types of these symbols */
626 #define Sym(vvv) extern void vvv(void);
627 #define SymX(vvv) /**/
628 #define SymX_redirect(vvv,xxx) /**/
632 RTS_POSIX_ONLY_SYMBOLS
633 RTS_MINGW_ONLY_SYMBOLS
634 RTS_CYGWIN_ONLY_SYMBOLS
640 #ifdef LEADING_UNDERSCORE
641 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
643 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
646 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
648 #define SymX(vvv) Sym(vvv)
650 // SymX_redirect allows us to redirect references to one symbol to
651 // another symbol. See newCAF/newDynCAF for an example.
652 #define SymX_redirect(vvv,xxx) \
653 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
656 static RtsSymbolVal rtsSyms[] = {
660 RTS_POSIX_ONLY_SYMBOLS
661 RTS_MINGW_ONLY_SYMBOLS
662 RTS_CYGWIN_ONLY_SYMBOLS
664 { 0, 0 } /* sentinel */
667 /* -----------------------------------------------------------------------------
668 * Insert symbols into hash tables, checking for duplicates.
670 static void ghciInsertStrHashTable ( char* obj_name,
676 if (lookupHashTable(table, (StgWord)key) == NULL)
678 insertStrHashTable(table, (StgWord)key, data);
683 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
685 "whilst processing object file\n"
687 "This could be caused by:\n"
688 " * Loading two different object files which export the same symbol\n"
689 " * Specifying the same object file twice on the GHCi command line\n"
690 " * An incorrect `package.conf' entry, causing some object to be\n"
692 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
701 /* -----------------------------------------------------------------------------
702 * initialize the object linker
706 static int linker_init_done = 0 ;
708 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
709 static void *dl_prog_handle;
712 /* dlopen(NULL,..) doesn't work so we grab libc explicitly */
713 #if defined(openbsd_TARGET_OS)
714 static void *dl_libc_handle;
722 /* Make initLinker idempotent, so we can call it
723 before evey relevant operation; that means we
724 don't need to initialise the linker separately */
725 if (linker_init_done == 1) { return; } else {
726 linker_init_done = 1;
729 symhash = allocStrHashTable();
731 /* populate the symbol table with stuff from the RTS */
732 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
733 ghciInsertStrHashTable("(GHCi built-in symbols)",
734 symhash, sym->lbl, sym->addr);
736 # if defined(OBJFORMAT_MACHO)
737 machoInitSymbolsWithoutUnderscore();
740 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
741 # if defined(RTLD_DEFAULT)
742 dl_prog_handle = RTLD_DEFAULT;
744 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
745 # if defined(openbsd_TARGET_OS)
746 dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
748 # endif // RTLD_DEFAULT
752 /* -----------------------------------------------------------------------------
753 * Loading DLL or .so dynamic libraries
754 * -----------------------------------------------------------------------------
756 * Add a DLL from which symbols may be found. In the ELF case, just
757 * do RTLD_GLOBAL-style add, so no further messing around needs to
758 * happen in order that symbols in the loaded .so are findable --
759 * lookupSymbol() will subsequently see them by dlsym on the program's
760 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
762 * In the PEi386 case, open the DLLs and put handles to them in a
763 * linked list. When looking for a symbol, try all handles in the
764 * list. This means that we need to load even DLLs that are guaranteed
765 * to be in the ghc.exe image already, just so we can get a handle
766 * to give to loadSymbol, so that we can find the symbols. For such
767 * libraries, the LoadLibrary call should be a no-op except for returning
772 #if defined(OBJFORMAT_PEi386)
773 /* A record for storing handles into DLLs. */
778 struct _OpenedDLL* next;
783 /* A list thereof. */
784 static OpenedDLL* opened_dlls = NULL;
788 addDLL( char *dll_name )
790 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
791 /* ------------------- ELF DLL loader ------------------- */
797 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
800 /* dlopen failed; return a ptr to the error msg. */
802 if (errmsg == NULL) errmsg = "addDLL: unknown error";
809 # elif defined(OBJFORMAT_PEi386)
810 /* ------------------- Win32 DLL loader ------------------- */
818 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
820 /* See if we've already got it, and ignore if so. */
821 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
822 if (0 == strcmp(o_dll->name, dll_name))
826 /* The file name has no suffix (yet) so that we can try
827 both foo.dll and foo.drv
829 The documentation for LoadLibrary says:
830 If no file name extension is specified in the lpFileName
831 parameter, the default library extension .dll is
832 appended. However, the file name string can include a trailing
833 point character (.) to indicate that the module name has no
836 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
837 sprintf(buf, "%s.DLL", dll_name);
838 instance = LoadLibrary(buf);
839 if (instance == NULL) {
840 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
841 instance = LoadLibrary(buf);
842 if (instance == NULL) {
845 /* LoadLibrary failed; return a ptr to the error msg. */
846 return "addDLL: unknown error";
851 /* Add this DLL to the list of DLLs in which to search for symbols. */
852 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
853 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
854 strcpy(o_dll->name, dll_name);
855 o_dll->instance = instance;
856 o_dll->next = opened_dlls;
861 barf("addDLL: not implemented on this platform");
865 /* -----------------------------------------------------------------------------
866 * lookup a symbol in the hash table
869 lookupSymbol( char *lbl )
873 ASSERT(symhash != NULL);
874 val = lookupStrHashTable(symhash, lbl);
877 # if defined(OBJFORMAT_ELF)
878 # if defined(openbsd_TARGET_OS)
879 val = dlsym(dl_prog_handle, lbl);
880 return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
881 # else /* not openbsd */
882 return dlsym(dl_prog_handle, lbl);
884 # elif defined(OBJFORMAT_MACHO)
885 if(NSIsSymbolNameDefined(lbl)) {
886 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
887 return NSAddressOfSymbol(symbol);
891 # elif defined(OBJFORMAT_PEi386)
894 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
895 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
897 /* HACK: if the name has an initial underscore, try stripping
898 it off & look that up first. I've yet to verify whether there's
899 a Rule that governs whether an initial '_' *should always* be
900 stripped off when mapping from import lib name to the DLL name.
902 sym = GetProcAddress(o_dll->instance, (lbl+1));
904 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
908 sym = GetProcAddress(o_dll->instance, lbl);
910 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
925 __attribute((unused))
927 lookupLocalSymbol( ObjectCode* oc, char *lbl )
931 val = lookupStrHashTable(oc->lochash, lbl);
941 /* -----------------------------------------------------------------------------
942 * Debugging aid: look in GHCi's object symbol tables for symbols
943 * within DELTA bytes of the specified address, and show their names.
946 void ghci_enquire ( char* addr );
948 void ghci_enquire ( char* addr )
953 const int DELTA = 64;
958 for (oc = objects; oc; oc = oc->next) {
959 for (i = 0; i < oc->n_symbols; i++) {
960 sym = oc->symbols[i];
961 if (sym == NULL) continue;
962 // debugBelch("enquire %p %p\n", sym, oc->lochash);
964 if (oc->lochash != NULL) {
965 a = lookupStrHashTable(oc->lochash, sym);
968 a = lookupStrHashTable(symhash, sym);
971 // debugBelch("ghci_enquire: can't find %s\n", sym);
973 else if (addr-DELTA <= a && a <= addr+DELTA) {
974 debugBelch("%p + %3d == `%s'\n", addr, a - addr, sym);
981 #ifdef ia64_TARGET_ARCH
982 static unsigned int PLTSize(void);
985 /* -----------------------------------------------------------------------------
986 * Load an obj (populate the global symbol table, but don't resolve yet)
988 * Returns: 1 if ok, 0 on error.
991 loadObj( char *path )
998 void *map_addr = NULL;
1005 /* debugBelch("loadObj %s\n", path ); */
1007 /* Check that we haven't already loaded this object.
1008 Ignore requests to load multiple times */
1012 for (o = objects; o; o = o->next) {
1013 if (0 == strcmp(o->fileName, path)) {
1015 break; /* don't need to search further */
1019 IF_DEBUG(linker, debugBelch(
1020 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1021 "same object file twice:\n"
1023 "GHCi will ignore this, but be warned.\n"
1025 return 1; /* success */
1029 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1031 # if defined(OBJFORMAT_ELF)
1032 oc->formatName = "ELF";
1033 # elif defined(OBJFORMAT_PEi386)
1034 oc->formatName = "PEi386";
1035 # elif defined(OBJFORMAT_MACHO)
1036 oc->formatName = "Mach-O";
1039 barf("loadObj: not implemented on this platform");
1042 r = stat(path, &st);
1043 if (r == -1) { return 0; }
1045 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1046 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1047 strcpy(oc->fileName, path);
1049 oc->fileSize = st.st_size;
1051 oc->sections = NULL;
1052 oc->lochash = allocStrHashTable();
1053 oc->proddables = NULL;
1055 /* chain it onto the list of objects */
1060 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1062 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1064 #if defined(openbsd_TARGET_OS)
1065 fd = open(path, O_RDONLY, S_IRUSR);
1067 fd = open(path, O_RDONLY);
1070 barf("loadObj: can't open `%s'", path);
1072 pagesize = getpagesize();
1074 #ifdef ia64_TARGET_ARCH
1075 /* The PLT needs to be right before the object */
1076 n = ROUND_UP(PLTSize(), pagesize);
1077 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1078 if (oc->plt == MAP_FAILED)
1079 barf("loadObj: can't allocate PLT");
1082 map_addr = oc->plt + n;
1085 n = ROUND_UP(oc->fileSize, pagesize);
1086 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1087 if (oc->image == MAP_FAILED)
1088 barf("loadObj: can't map `%s'", path);
1092 #else /* !USE_MMAP */
1094 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1096 /* load the image into memory */
1097 f = fopen(path, "rb");
1099 barf("loadObj: can't read `%s'", path);
1101 n = fread ( oc->image, 1, oc->fileSize, f );
1102 if (n != oc->fileSize)
1103 barf("loadObj: error whilst reading `%s'", path);
1107 #endif /* USE_MMAP */
1109 # if defined(OBJFORMAT_MACHO)
1110 r = ocAllocateJumpIslands_MachO ( oc );
1111 if (!r) { return r; }
1112 # elif defined(OBJFORMAT_ELF) && defined(powerpc_TARGET_ARCH)
1113 r = ocAllocateJumpIslands_ELF ( oc );
1114 if (!r) { return r; }
1117 /* verify the in-memory image */
1118 # if defined(OBJFORMAT_ELF)
1119 r = ocVerifyImage_ELF ( oc );
1120 # elif defined(OBJFORMAT_PEi386)
1121 r = ocVerifyImage_PEi386 ( oc );
1122 # elif defined(OBJFORMAT_MACHO)
1123 r = ocVerifyImage_MachO ( oc );
1125 barf("loadObj: no verify method");
1127 if (!r) { return r; }
1129 /* build the symbol list for this image */
1130 # if defined(OBJFORMAT_ELF)
1131 r = ocGetNames_ELF ( oc );
1132 # elif defined(OBJFORMAT_PEi386)
1133 r = ocGetNames_PEi386 ( oc );
1134 # elif defined(OBJFORMAT_MACHO)
1135 r = ocGetNames_MachO ( oc );
1137 barf("loadObj: no getNames method");
1139 if (!r) { return r; }
1141 /* loaded, but not resolved yet */
1142 oc->status = OBJECT_LOADED;
1147 /* -----------------------------------------------------------------------------
1148 * resolve all the currently unlinked objects in memory
1150 * Returns: 1 if ok, 0 on error.
1160 for (oc = objects; oc; oc = oc->next) {
1161 if (oc->status != OBJECT_RESOLVED) {
1162 # if defined(OBJFORMAT_ELF)
1163 r = ocResolve_ELF ( oc );
1164 # elif defined(OBJFORMAT_PEi386)
1165 r = ocResolve_PEi386 ( oc );
1166 # elif defined(OBJFORMAT_MACHO)
1167 r = ocResolve_MachO ( oc );
1169 barf("resolveObjs: not implemented on this platform");
1171 if (!r) { return r; }
1172 oc->status = OBJECT_RESOLVED;
1178 /* -----------------------------------------------------------------------------
1179 * delete an object from the pool
1182 unloadObj( char *path )
1184 ObjectCode *oc, *prev;
1186 ASSERT(symhash != NULL);
1187 ASSERT(objects != NULL);
1192 for (oc = objects; oc; prev = oc, oc = oc->next) {
1193 if (!strcmp(oc->fileName,path)) {
1195 /* Remove all the mappings for the symbols within this
1200 for (i = 0; i < oc->n_symbols; i++) {
1201 if (oc->symbols[i] != NULL) {
1202 removeStrHashTable(symhash, oc->symbols[i], NULL);
1210 prev->next = oc->next;
1213 /* We're going to leave this in place, in case there are
1214 any pointers from the heap into it: */
1215 /* stgFree(oc->image); */
1216 stgFree(oc->fileName);
1217 stgFree(oc->symbols);
1218 stgFree(oc->sections);
1219 /* The local hash table should have been freed at the end
1220 of the ocResolve_ call on it. */
1221 ASSERT(oc->lochash == NULL);
1227 errorBelch("unloadObj: can't find `%s' to unload", path);
1231 /* -----------------------------------------------------------------------------
1232 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1233 * which may be prodded during relocation, and abort if we try and write
1234 * outside any of these.
1236 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1239 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1240 /* debugBelch("aPB %p %p %d\n", oc, start, size); */
1244 pb->next = oc->proddables;
1245 oc->proddables = pb;
1248 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1251 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1252 char* s = (char*)(pb->start);
1253 char* e = s + pb->size - 1;
1254 char* a = (char*)addr;
1255 /* Assumes that the biggest fixup involves a 4-byte write. This
1256 probably needs to be changed to 8 (ie, +7) on 64-bit
1258 if (a >= s && (a+3) <= e) return;
1260 barf("checkProddableBlock: invalid fixup in runtime linker");
1263 /* -----------------------------------------------------------------------------
1264 * Section management.
1266 static void addSection ( ObjectCode* oc, SectionKind kind,
1267 void* start, void* end )
1269 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1273 s->next = oc->sections;
1276 debugBelch("addSection: %p-%p (size %d), kind %d\n",
1277 start, ((char*)end)-1, end - start + 1, kind );
1282 /* --------------------------------------------------------------------------
1283 * PowerPC specifics (jump islands)
1284 * ------------------------------------------------------------------------*/
1286 #if defined(powerpc_TARGET_ARCH)
1289 ocAllocateJumpIslands
1291 Allocate additional space at the end of the object file image to make room
1294 PowerPC relative branch instructions have a 24 bit displacement field.
1295 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
1296 If a particular imported symbol is outside this range, we have to redirect
1297 the jump to a short piece of new code that just loads the 32bit absolute
1298 address and jumps there.
1299 This function just allocates space for one 16 byte ppcJumpIsland for every
1300 undefined symbol in the object file. The code for the islands is filled in by
1301 makeJumpIsland below.
1304 static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first )
1311 #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined
1313 // round up to the nearest 4
1314 aligned = (oc->fileSize + 3) & ~3;
1316 oc->image = stgReallocBytes( oc->image,
1317 aligned + sizeof( ppcJumpIsland ) * count,
1318 "ocAllocateJumpIslands" );
1319 oc->jump_islands = (ppcJumpIsland *) (((char *) oc->image) + aligned);
1320 memset( oc->jump_islands, 0, sizeof( ppcJumpIsland ) * count );
1323 oc->jump_islands = NULL;
1325 oc->island_start_symbol = first;
1326 oc->n_islands = count;
1331 static unsigned long makeJumpIsland( ObjectCode* oc,
1332 unsigned long symbolNumber,
1333 unsigned long target )
1335 ppcJumpIsland *island;
1337 if( symbolNumber < oc->island_start_symbol ||
1338 symbolNumber - oc->island_start_symbol > oc->n_islands)
1341 island = &oc->jump_islands[symbolNumber - oc->island_start_symbol];
1343 // lis r12, hi16(target)
1344 island->lis_r12 = 0x3d80;
1345 island->hi_addr = target >> 16;
1347 // ori r12, r12, lo16(target)
1348 island->ori_r12_r12 = 0x618c;
1349 island->lo_addr = target & 0xffff;
1352 island->mtctr_r12 = 0x7d8903a6;
1355 island->bctr = 0x4e800420;
1357 return (unsigned long) island;
1361 ocFlushInstructionCache
1363 Flush the data & instruction caches.
1364 Because the PPC has split data/instruction caches, we have to
1365 do that whenever we modify code at runtime.
1368 static void ocFlushInstructionCache( ObjectCode *oc )
1370 int n = (oc->fileSize + sizeof( ppcJumpIsland ) * oc->n_islands + 3) / 4;
1371 unsigned long *p = (unsigned long *) oc->image;
1375 __asm__ volatile ( "dcbf 0,%0\n\t"
1383 __asm__ volatile ( "sync\n\t"
1389 /* --------------------------------------------------------------------------
1390 * PEi386 specifics (Win32 targets)
1391 * ------------------------------------------------------------------------*/
1393 /* The information for this linker comes from
1394 Microsoft Portable Executable
1395 and Common Object File Format Specification
1396 revision 5.1 January 1998
1397 which SimonM says comes from the MS Developer Network CDs.
1399 It can be found there (on older CDs), but can also be found
1402 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1404 (this is Rev 6.0 from February 1999).
1406 Things move, so if that fails, try searching for it via
1408 http://www.google.com/search?q=PE+COFF+specification
1410 The ultimate reference for the PE format is the Winnt.h
1411 header file that comes with the Platform SDKs; as always,
1412 implementations will drift wrt their documentation.
1414 A good background article on the PE format is Matt Pietrek's
1415 March 1994 article in Microsoft System Journal (MSJ)
1416 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1417 Win32 Portable Executable File Format." The info in there
1418 has recently been updated in a two part article in
1419 MSDN magazine, issues Feb and March 2002,
1420 "Inside Windows: An In-Depth Look into the Win32 Portable
1421 Executable File Format"
1423 John Levine's book "Linkers and Loaders" contains useful
1428 #if defined(OBJFORMAT_PEi386)
1432 typedef unsigned char UChar;
1433 typedef unsigned short UInt16;
1434 typedef unsigned int UInt32;
1441 UInt16 NumberOfSections;
1442 UInt32 TimeDateStamp;
1443 UInt32 PointerToSymbolTable;
1444 UInt32 NumberOfSymbols;
1445 UInt16 SizeOfOptionalHeader;
1446 UInt16 Characteristics;
1450 #define sizeof_COFF_header 20
1457 UInt32 VirtualAddress;
1458 UInt32 SizeOfRawData;
1459 UInt32 PointerToRawData;
1460 UInt32 PointerToRelocations;
1461 UInt32 PointerToLinenumbers;
1462 UInt16 NumberOfRelocations;
1463 UInt16 NumberOfLineNumbers;
1464 UInt32 Characteristics;
1468 #define sizeof_COFF_section 40
1475 UInt16 SectionNumber;
1478 UChar NumberOfAuxSymbols;
1482 #define sizeof_COFF_symbol 18
1487 UInt32 VirtualAddress;
1488 UInt32 SymbolTableIndex;
1493 #define sizeof_COFF_reloc 10
1496 /* From PE spec doc, section 3.3.2 */
1497 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1498 windows.h -- for the same purpose, but I want to know what I'm
1500 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1501 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1502 #define MYIMAGE_FILE_DLL 0x2000
1503 #define MYIMAGE_FILE_SYSTEM 0x1000
1504 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1505 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1506 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1508 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1509 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1510 #define MYIMAGE_SYM_CLASS_STATIC 3
1511 #define MYIMAGE_SYM_UNDEFINED 0
1513 /* From PE spec doc, section 4.1 */
1514 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1515 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1516 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1518 /* From PE spec doc, section 5.2.1 */
1519 #define MYIMAGE_REL_I386_DIR32 0x0006
1520 #define MYIMAGE_REL_I386_REL32 0x0014
1523 /* We use myindex to calculate array addresses, rather than
1524 simply doing the normal subscript thing. That's because
1525 some of the above structs have sizes which are not
1526 a whole number of words. GCC rounds their sizes up to a
1527 whole number of words, which means that the address calcs
1528 arising from using normal C indexing or pointer arithmetic
1529 are just plain wrong. Sigh.
1532 myindex ( int scale, void* base, int index )
1535 ((UChar*)base) + scale * index;
1540 printName ( UChar* name, UChar* strtab )
1542 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1543 UInt32 strtab_offset = * (UInt32*)(name+4);
1544 debugBelch("%s", strtab + strtab_offset );
1547 for (i = 0; i < 8; i++) {
1548 if (name[i] == 0) break;
1549 debugBelch("%c", name[i] );
1556 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1558 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1559 UInt32 strtab_offset = * (UInt32*)(name+4);
1560 strncpy ( dst, strtab+strtab_offset, dstSize );
1566 if (name[i] == 0) break;
1576 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1579 /* If the string is longer than 8 bytes, look in the
1580 string table for it -- this will be correctly zero terminated.
1582 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1583 UInt32 strtab_offset = * (UInt32*)(name+4);
1584 return ((UChar*)strtab) + strtab_offset;
1586 /* Otherwise, if shorter than 8 bytes, return the original,
1587 which by defn is correctly terminated.
1589 if (name[7]==0) return name;
1590 /* The annoying case: 8 bytes. Copy into a temporary
1591 (which is never freed ...)
1593 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1595 strncpy(newstr,name,8);
1601 /* Just compares the short names (first 8 chars) */
1602 static COFF_section *
1603 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1607 = (COFF_header*)(oc->image);
1608 COFF_section* sectab
1610 ((UChar*)(oc->image))
1611 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1613 for (i = 0; i < hdr->NumberOfSections; i++) {
1616 COFF_section* section_i
1618 myindex ( sizeof_COFF_section, sectab, i );
1619 n1 = (UChar*) &(section_i->Name);
1621 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1622 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1623 n1[6]==n2[6] && n1[7]==n2[7])
1632 zapTrailingAtSign ( UChar* sym )
1634 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1636 if (sym[0] == 0) return;
1638 while (sym[i] != 0) i++;
1641 while (j > 0 && my_isdigit(sym[j])) j--;
1642 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1648 ocVerifyImage_PEi386 ( ObjectCode* oc )
1653 COFF_section* sectab;
1654 COFF_symbol* symtab;
1656 /* debugBelch("\nLOADING %s\n", oc->fileName); */
1657 hdr = (COFF_header*)(oc->image);
1658 sectab = (COFF_section*) (
1659 ((UChar*)(oc->image))
1660 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1662 symtab = (COFF_symbol*) (
1663 ((UChar*)(oc->image))
1664 + hdr->PointerToSymbolTable
1666 strtab = ((UChar*)symtab)
1667 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1669 if (hdr->Machine != 0x14c) {
1670 errorBelch("Not x86 PEi386");
1673 if (hdr->SizeOfOptionalHeader != 0) {
1674 errorBelch("PEi386 with nonempty optional header");
1677 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1678 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1679 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1680 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1681 errorBelch("Not a PEi386 object file");
1684 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1685 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1686 errorBelch("Invalid PEi386 word size or endiannness: %d",
1687 (int)(hdr->Characteristics));
1690 /* If the string table size is way crazy, this might indicate that
1691 there are more than 64k relocations, despite claims to the
1692 contrary. Hence this test. */
1693 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
1695 if ( (*(UInt32*)strtab) > 600000 ) {
1696 /* Note that 600k has no special significance other than being
1697 big enough to handle the almost-2MB-sized lumps that
1698 constitute HSwin32*.o. */
1699 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
1704 /* No further verification after this point; only debug printing. */
1706 IF_DEBUG(linker, i=1);
1707 if (i == 0) return 1;
1709 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1710 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1711 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1714 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1715 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1716 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1717 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1718 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1719 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1720 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1722 /* Print the section table. */
1724 for (i = 0; i < hdr->NumberOfSections; i++) {
1726 COFF_section* sectab_i
1728 myindex ( sizeof_COFF_section, sectab, i );
1735 printName ( sectab_i->Name, strtab );
1745 sectab_i->VirtualSize,
1746 sectab_i->VirtualAddress,
1747 sectab_i->SizeOfRawData,
1748 sectab_i->PointerToRawData,
1749 sectab_i->NumberOfRelocations,
1750 sectab_i->PointerToRelocations,
1751 sectab_i->PointerToRawData
1753 reltab = (COFF_reloc*) (
1754 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1757 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1758 /* If the relocation field (a short) has overflowed, the
1759 * real count can be found in the first reloc entry.
1761 * See Section 4.1 (last para) of the PE spec (rev6.0).
1763 COFF_reloc* rel = (COFF_reloc*)
1764 myindex ( sizeof_COFF_reloc, reltab, 0 );
1765 noRelocs = rel->VirtualAddress;
1768 noRelocs = sectab_i->NumberOfRelocations;
1772 for (; j < noRelocs; j++) {
1774 COFF_reloc* rel = (COFF_reloc*)
1775 myindex ( sizeof_COFF_reloc, reltab, j );
1777 " type 0x%-4x vaddr 0x%-8x name `",
1779 rel->VirtualAddress );
1780 sym = (COFF_symbol*)
1781 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1782 /* Hmm..mysterious looking offset - what's it for? SOF */
1783 printName ( sym->Name, strtab -10 );
1790 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
1791 debugBelch("---START of string table---\n");
1792 for (i = 4; i < *(Int32*)strtab; i++) {
1794 debugBelch("\n"); else
1795 debugBelch("%c", strtab[i] );
1797 debugBelch("--- END of string table---\n");
1802 COFF_symbol* symtab_i;
1803 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1804 symtab_i = (COFF_symbol*)
1805 myindex ( sizeof_COFF_symbol, symtab, i );
1811 printName ( symtab_i->Name, strtab );
1820 (Int32)(symtab_i->SectionNumber),
1821 (UInt32)symtab_i->Type,
1822 (UInt32)symtab_i->StorageClass,
1823 (UInt32)symtab_i->NumberOfAuxSymbols
1825 i += symtab_i->NumberOfAuxSymbols;
1835 ocGetNames_PEi386 ( ObjectCode* oc )
1838 COFF_section* sectab;
1839 COFF_symbol* symtab;
1846 hdr = (COFF_header*)(oc->image);
1847 sectab = (COFF_section*) (
1848 ((UChar*)(oc->image))
1849 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1851 symtab = (COFF_symbol*) (
1852 ((UChar*)(oc->image))
1853 + hdr->PointerToSymbolTable
1855 strtab = ((UChar*)(oc->image))
1856 + hdr->PointerToSymbolTable
1857 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1859 /* Allocate space for any (local, anonymous) .bss sections. */
1861 for (i = 0; i < hdr->NumberOfSections; i++) {
1863 COFF_section* sectab_i
1865 myindex ( sizeof_COFF_section, sectab, i );
1866 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1867 if (sectab_i->VirtualSize == 0) continue;
1868 /* This is a non-empty .bss section. Allocate zeroed space for
1869 it, and set its PointerToRawData field such that oc->image +
1870 PointerToRawData == addr_of_zeroed_space. */
1871 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1872 "ocGetNames_PEi386(anonymous bss)");
1873 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1874 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1875 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
1878 /* Copy section information into the ObjectCode. */
1880 for (i = 0; i < hdr->NumberOfSections; i++) {
1886 = SECTIONKIND_OTHER;
1887 COFF_section* sectab_i
1889 myindex ( sizeof_COFF_section, sectab, i );
1890 IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
1893 /* I'm sure this is the Right Way to do it. However, the
1894 alternative of testing the sectab_i->Name field seems to
1895 work ok with Cygwin.
1897 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1898 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1899 kind = SECTIONKIND_CODE_OR_RODATA;
1902 if (0==strcmp(".text",sectab_i->Name) ||
1903 0==strcmp(".rodata",sectab_i->Name))
1904 kind = SECTIONKIND_CODE_OR_RODATA;
1905 if (0==strcmp(".data",sectab_i->Name) ||
1906 0==strcmp(".bss",sectab_i->Name))
1907 kind = SECTIONKIND_RWDATA;
1909 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1910 sz = sectab_i->SizeOfRawData;
1911 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1913 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1914 end = start + sz - 1;
1916 if (kind == SECTIONKIND_OTHER
1917 /* Ignore sections called which contain stabs debugging
1919 && 0 != strcmp(".stab", sectab_i->Name)
1920 && 0 != strcmp(".stabstr", sectab_i->Name)
1922 errorBelch("Unknown PEi386 section name `%s'", sectab_i->Name);
1926 if (kind != SECTIONKIND_OTHER && end >= start) {
1927 addSection(oc, kind, start, end);
1928 addProddableBlock(oc, start, end - start + 1);
1932 /* Copy exported symbols into the ObjectCode. */
1934 oc->n_symbols = hdr->NumberOfSymbols;
1935 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1936 "ocGetNames_PEi386(oc->symbols)");
1937 /* Call me paranoid; I don't care. */
1938 for (i = 0; i < oc->n_symbols; i++)
1939 oc->symbols[i] = NULL;
1943 COFF_symbol* symtab_i;
1944 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1945 symtab_i = (COFF_symbol*)
1946 myindex ( sizeof_COFF_symbol, symtab, i );
1950 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1951 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1952 /* This symbol is global and defined, viz, exported */
1953 /* for MYIMAGE_SYMCLASS_EXTERNAL
1954 && !MYIMAGE_SYM_UNDEFINED,
1955 the address of the symbol is:
1956 address of relevant section + offset in section
1958 COFF_section* sectabent
1959 = (COFF_section*) myindex ( sizeof_COFF_section,
1961 symtab_i->SectionNumber-1 );
1962 addr = ((UChar*)(oc->image))
1963 + (sectabent->PointerToRawData
1967 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1968 && symtab_i->Value > 0) {
1969 /* This symbol isn't in any section at all, ie, global bss.
1970 Allocate zeroed space for it. */
1971 addr = stgCallocBytes(1, symtab_i->Value,
1972 "ocGetNames_PEi386(non-anonymous bss)");
1973 addSection(oc, SECTIONKIND_RWDATA, addr,
1974 ((UChar*)addr) + symtab_i->Value - 1);
1975 addProddableBlock(oc, addr, symtab_i->Value);
1976 /* debugBelch("BSS section at 0x%x\n", addr); */
1979 if (addr != NULL ) {
1980 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1981 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
1982 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
1983 ASSERT(i >= 0 && i < oc->n_symbols);
1984 /* cstring_from_COFF_symbol_name always succeeds. */
1985 oc->symbols[i] = sname;
1986 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1990 "IGNORING symbol %d\n"
1994 printName ( symtab_i->Name, strtab );
2003 (Int32)(symtab_i->SectionNumber),
2004 (UInt32)symtab_i->Type,
2005 (UInt32)symtab_i->StorageClass,
2006 (UInt32)symtab_i->NumberOfAuxSymbols
2011 i += symtab_i->NumberOfAuxSymbols;
2020 ocResolve_PEi386 ( ObjectCode* oc )
2023 COFF_section* sectab;
2024 COFF_symbol* symtab;
2034 /* ToDo: should be variable-sized? But is at least safe in the
2035 sense of buffer-overrun-proof. */
2037 /* debugBelch("resolving for %s\n", oc->fileName); */
2039 hdr = (COFF_header*)(oc->image);
2040 sectab = (COFF_section*) (
2041 ((UChar*)(oc->image))
2042 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2044 symtab = (COFF_symbol*) (
2045 ((UChar*)(oc->image))
2046 + hdr->PointerToSymbolTable
2048 strtab = ((UChar*)(oc->image))
2049 + hdr->PointerToSymbolTable
2050 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2052 for (i = 0; i < hdr->NumberOfSections; i++) {
2053 COFF_section* sectab_i
2055 myindex ( sizeof_COFF_section, sectab, i );
2058 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2061 /* Ignore sections called which contain stabs debugging
2063 if (0 == strcmp(".stab", sectab_i->Name)
2064 || 0 == strcmp(".stabstr", sectab_i->Name))
2067 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2068 /* If the relocation field (a short) has overflowed, the
2069 * real count can be found in the first reloc entry.
2071 * See Section 4.1 (last para) of the PE spec (rev6.0).
2073 * Nov2003 update: the GNU linker still doesn't correctly
2074 * handle the generation of relocatable object files with
2075 * overflown relocations. Hence the output to warn of potential
2078 COFF_reloc* rel = (COFF_reloc*)
2079 myindex ( sizeof_COFF_reloc, reltab, 0 );
2080 noRelocs = rel->VirtualAddress;
2081 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
2085 noRelocs = sectab_i->NumberOfRelocations;
2090 for (; j < noRelocs; j++) {
2092 COFF_reloc* reltab_j
2094 myindex ( sizeof_COFF_reloc, reltab, j );
2096 /* the location to patch */
2098 ((UChar*)(oc->image))
2099 + (sectab_i->PointerToRawData
2100 + reltab_j->VirtualAddress
2101 - sectab_i->VirtualAddress )
2103 /* the existing contents of pP */
2105 /* the symbol to connect to */
2106 sym = (COFF_symbol*)
2107 myindex ( sizeof_COFF_symbol,
2108 symtab, reltab_j->SymbolTableIndex );
2111 "reloc sec %2d num %3d: type 0x%-4x "
2112 "vaddr 0x%-8x name `",
2114 (UInt32)reltab_j->Type,
2115 reltab_j->VirtualAddress );
2116 printName ( sym->Name, strtab );
2117 debugBelch("'\n" ));
2119 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2120 COFF_section* section_sym
2121 = findPEi386SectionCalled ( oc, sym->Name );
2123 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
2126 S = ((UInt32)(oc->image))
2127 + (section_sym->PointerToRawData
2130 copyName ( sym->Name, strtab, symbol, 1000-1 );
2131 (void*)S = lookupLocalSymbol( oc, symbol );
2132 if ((void*)S != NULL) goto foundit;
2133 (void*)S = lookupSymbol( symbol );
2134 if ((void*)S != NULL) goto foundit;
2135 zapTrailingAtSign ( symbol );
2136 (void*)S = lookupLocalSymbol( oc, symbol );
2137 if ((void*)S != NULL) goto foundit;
2138 (void*)S = lookupSymbol( symbol );
2139 if ((void*)S != NULL) goto foundit;
2140 /* Newline first because the interactive linker has printed "linking..." */
2141 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2145 checkProddableBlock(oc, pP);
2146 switch (reltab_j->Type) {
2147 case MYIMAGE_REL_I386_DIR32:
2150 case MYIMAGE_REL_I386_REL32:
2151 /* Tricky. We have to insert a displacement at
2152 pP which, when added to the PC for the _next_
2153 insn, gives the address of the target (S).
2154 Problem is to know the address of the next insn
2155 when we only know pP. We assume that this
2156 literal field is always the last in the insn,
2157 so that the address of the next insn is pP+4
2158 -- hence the constant 4.
2159 Also I don't know if A should be added, but so
2160 far it has always been zero.
2163 *pP = S - ((UInt32)pP) - 4;
2166 debugBelch("%s: unhandled PEi386 relocation type %d",
2167 oc->fileName, reltab_j->Type);
2174 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
2178 #endif /* defined(OBJFORMAT_PEi386) */
2181 /* --------------------------------------------------------------------------
2183 * ------------------------------------------------------------------------*/
2185 #if defined(OBJFORMAT_ELF)
2190 #if defined(sparc_TARGET_ARCH)
2191 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2192 #elif defined(i386_TARGET_ARCH)
2193 # define ELF_TARGET_386 /* Used inside <elf.h> */
2194 #elif defined(x86_64_TARGET_ARCH)
2195 # define ELF_TARGET_X64_64
2197 #elif defined (ia64_TARGET_ARCH)
2198 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2200 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2201 # define ELF_NEED_GOT /* needs Global Offset Table */
2202 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2205 #if !defined(openbsd_TARGET_OS)
2208 /* openbsd elf has things in different places, with diff names */
2209 #include <elf_abi.h>
2210 #include <machine/reloc.h>
2211 #define R_386_32 RELOC_32
2212 #define R_386_PC32 RELOC_PC32
2216 * Define a set of types which can be used for both ELF32 and ELF64
2220 #define ELFCLASS ELFCLASS64
2221 #define Elf_Addr Elf64_Addr
2222 #define Elf_Word Elf64_Word
2223 #define Elf_Sword Elf64_Sword
2224 #define Elf_Ehdr Elf64_Ehdr
2225 #define Elf_Phdr Elf64_Phdr
2226 #define Elf_Shdr Elf64_Shdr
2227 #define Elf_Sym Elf64_Sym
2228 #define Elf_Rel Elf64_Rel
2229 #define Elf_Rela Elf64_Rela
2230 #define ELF_ST_TYPE ELF64_ST_TYPE
2231 #define ELF_ST_BIND ELF64_ST_BIND
2232 #define ELF_R_TYPE ELF64_R_TYPE
2233 #define ELF_R_SYM ELF64_R_SYM
2235 #define ELFCLASS ELFCLASS32
2236 #define Elf_Addr Elf32_Addr
2237 #define Elf_Word Elf32_Word
2238 #define Elf_Sword Elf32_Sword
2239 #define Elf_Ehdr Elf32_Ehdr
2240 #define Elf_Phdr Elf32_Phdr
2241 #define Elf_Shdr Elf32_Shdr
2242 #define Elf_Sym Elf32_Sym
2243 #define Elf_Rel Elf32_Rel
2244 #define Elf_Rela Elf32_Rela
2246 #define ELF_ST_TYPE ELF32_ST_TYPE
2249 #define ELF_ST_BIND ELF32_ST_BIND
2252 #define ELF_R_TYPE ELF32_R_TYPE
2255 #define ELF_R_SYM ELF32_R_SYM
2261 * Functions to allocate entries in dynamic sections. Currently we simply
2262 * preallocate a large number, and we don't check if a entry for the given
2263 * target already exists (a linear search is too slow). Ideally these
2264 * entries would be associated with symbols.
2267 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2268 #define GOT_SIZE 0x20000
2269 #define FUNCTION_TABLE_SIZE 0x10000
2270 #define PLT_SIZE 0x08000
2273 static Elf_Addr got[GOT_SIZE];
2274 static unsigned int gotIndex;
2275 static Elf_Addr gp_val = (Elf_Addr)got;
2278 allocateGOTEntry(Elf_Addr target)
2282 if (gotIndex >= GOT_SIZE)
2283 barf("Global offset table overflow");
2285 entry = &got[gotIndex++];
2287 return (Elf_Addr)entry;
2291 #ifdef ELF_FUNCTION_DESC
2297 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2298 static unsigned int functionTableIndex;
2301 allocateFunctionDesc(Elf_Addr target)
2303 FunctionDesc *entry;
2305 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2306 barf("Function table overflow");
2308 entry = &functionTable[functionTableIndex++];
2310 entry->gp = (Elf_Addr)gp_val;
2311 return (Elf_Addr)entry;
2315 copyFunctionDesc(Elf_Addr target)
2317 FunctionDesc *olddesc = (FunctionDesc *)target;
2318 FunctionDesc *newdesc;
2320 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2321 newdesc->gp = olddesc->gp;
2322 return (Elf_Addr)newdesc;
2327 #ifdef ia64_TARGET_ARCH
2328 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2329 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2331 static unsigned char plt_code[] =
2333 /* taken from binutils bfd/elfxx-ia64.c */
2334 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2335 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2336 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2337 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2338 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2339 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2342 /* If we can't get to the function descriptor via gp, take a local copy of it */
2343 #define PLT_RELOC(code, target) { \
2344 Elf64_Sxword rel_value = target - gp_val; \
2345 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2346 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2348 ia64_reloc_gprel22((Elf_Addr)code, target); \
2353 unsigned char code[sizeof(plt_code)];
2357 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2359 PLTEntry *plt = (PLTEntry *)oc->plt;
2362 if (oc->pltIndex >= PLT_SIZE)
2363 barf("Procedure table overflow");
2365 entry = &plt[oc->pltIndex++];
2366 memcpy(entry->code, plt_code, sizeof(entry->code));
2367 PLT_RELOC(entry->code, target);
2368 return (Elf_Addr)entry;
2374 return (PLT_SIZE * sizeof(PLTEntry));
2380 * Generic ELF functions
2384 findElfSection ( void* objImage, Elf_Word sh_type )
2386 char* ehdrC = (char*)objImage;
2387 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2388 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2389 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2393 for (i = 0; i < ehdr->e_shnum; i++) {
2394 if (shdr[i].sh_type == sh_type
2395 /* Ignore the section header's string table. */
2396 && i != ehdr->e_shstrndx
2397 /* Ignore string tables named .stabstr, as they contain
2399 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2401 ptr = ehdrC + shdr[i].sh_offset;
2408 #if defined(ia64_TARGET_ARCH)
2410 findElfSegment ( void* objImage, Elf_Addr vaddr )
2412 char* ehdrC = (char*)objImage;
2413 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2414 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2415 Elf_Addr segaddr = 0;
2418 for (i = 0; i < ehdr->e_phnum; i++) {
2419 segaddr = phdr[i].p_vaddr;
2420 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2428 ocVerifyImage_ELF ( ObjectCode* oc )
2432 int i, j, nent, nstrtab, nsymtabs;
2436 char* ehdrC = (char*)(oc->image);
2437 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2439 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2440 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2441 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2442 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2443 errorBelch("%s: not an ELF object", oc->fileName);
2447 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2448 errorBelch("%s: unsupported ELF format", oc->fileName);
2452 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2453 IF_DEBUG(linker,debugBelch( "Is little-endian" ));
2455 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2456 IF_DEBUG(linker,debugBelch( "Is big-endian" ));
2458 errorBelch("%s: unknown endiannness", oc->fileName);
2462 if (ehdr->e_type != ET_REL) {
2463 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
2466 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file" ));
2468 IF_DEBUG(linker,debugBelch( "Architecture is " ));
2469 switch (ehdr->e_machine) {
2470 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
2471 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
2473 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
2475 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
2476 default: IF_DEBUG(linker,debugBelch( "unknown" ));
2477 errorBelch("%s: unknown architecture", oc->fileName);
2481 IF_DEBUG(linker,debugBelch(
2482 "\nSection header table: start %d, n_entries %d, ent_size %d",
2483 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2485 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2487 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2489 if (ehdr->e_shstrndx == SHN_UNDEF) {
2490 errorBelch("%s: no section header string table", oc->fileName);
2493 IF_DEBUG(linker,debugBelch( "Section header string table is section %d",
2495 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2498 for (i = 0; i < ehdr->e_shnum; i++) {
2499 IF_DEBUG(linker,debugBelch("%2d: ", i ));
2500 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
2501 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
2502 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
2503 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
2504 ehdrC + shdr[i].sh_offset,
2505 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2507 if (shdr[i].sh_type == SHT_REL) {
2508 IF_DEBUG(linker,debugBelch("Rel " ));
2509 } else if (shdr[i].sh_type == SHT_RELA) {
2510 IF_DEBUG(linker,debugBelch("RelA " ));
2512 IF_DEBUG(linker,debugBelch(" "));
2515 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
2519 IF_DEBUG(linker,debugBelch( "\nString tables" ));
2522 for (i = 0; i < ehdr->e_shnum; i++) {
2523 if (shdr[i].sh_type == SHT_STRTAB
2524 /* Ignore the section header's string table. */
2525 && i != ehdr->e_shstrndx
2526 /* Ignore string tables named .stabstr, as they contain
2528 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2530 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
2531 strtab = ehdrC + shdr[i].sh_offset;
2536 errorBelch("%s: no string tables, or too many", oc->fileName);
2541 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
2542 for (i = 0; i < ehdr->e_shnum; i++) {
2543 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2544 IF_DEBUG(linker,debugBelch( "section %d is a symbol table", i ));
2546 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2547 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2548 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%d rem)",
2550 shdr[i].sh_size % sizeof(Elf_Sym)
2552 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2553 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
2556 for (j = 0; j < nent; j++) {
2557 IF_DEBUG(linker,debugBelch(" %2d ", j ));
2558 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
2559 (int)stab[j].st_shndx,
2560 (int)stab[j].st_size,
2561 (char*)stab[j].st_value ));
2563 IF_DEBUG(linker,debugBelch("type=" ));
2564 switch (ELF_ST_TYPE(stab[j].st_info)) {
2565 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
2566 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
2567 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
2568 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
2569 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
2570 default: IF_DEBUG(linker,debugBelch("? " )); break;
2572 IF_DEBUG(linker,debugBelch(" " ));
2574 IF_DEBUG(linker,debugBelch("bind=" ));
2575 switch (ELF_ST_BIND(stab[j].st_info)) {
2576 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
2577 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
2578 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
2579 default: IF_DEBUG(linker,debugBelch("? " )); break;
2581 IF_DEBUG(linker,debugBelch(" " ));
2583 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
2587 if (nsymtabs == 0) {
2588 errorBelch("%s: didn't find any symbol tables", oc->fileName);
2597 ocGetNames_ELF ( ObjectCode* oc )
2602 char* ehdrC = (char*)(oc->image);
2603 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2604 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2605 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2607 ASSERT(symhash != NULL);
2610 errorBelch("%s: no strtab", oc->fileName);
2615 for (i = 0; i < ehdr->e_shnum; i++) {
2616 /* Figure out what kind of section it is. Logic derived from
2617 Figure 1.14 ("Special Sections") of the ELF document
2618 ("Portable Formats Specification, Version 1.1"). */
2619 Elf_Shdr hdr = shdr[i];
2620 SectionKind kind = SECTIONKIND_OTHER;
2623 if (hdr.sh_type == SHT_PROGBITS
2624 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2625 /* .text-style section */
2626 kind = SECTIONKIND_CODE_OR_RODATA;
2629 if (hdr.sh_type == SHT_PROGBITS
2630 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2631 /* .data-style section */
2632 kind = SECTIONKIND_RWDATA;
2635 if (hdr.sh_type == SHT_PROGBITS
2636 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2637 /* .rodata-style section */
2638 kind = SECTIONKIND_CODE_OR_RODATA;
2641 if (hdr.sh_type == SHT_NOBITS
2642 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2643 /* .bss-style section */
2644 kind = SECTIONKIND_RWDATA;
2648 if (is_bss && shdr[i].sh_size > 0) {
2649 /* This is a non-empty .bss section. Allocate zeroed space for
2650 it, and set its .sh_offset field such that
2651 ehdrC + .sh_offset == addr_of_zeroed_space. */
2652 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2653 "ocGetNames_ELF(BSS)");
2654 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2656 debugBelch("BSS section at 0x%x, size %d\n",
2657 zspace, shdr[i].sh_size);
2661 /* fill in the section info */
2662 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2663 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2664 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2665 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2668 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2670 /* copy stuff into this module's object symbol table */
2671 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2672 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2674 oc->n_symbols = nent;
2675 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2676 "ocGetNames_ELF(oc->symbols)");
2678 for (j = 0; j < nent; j++) {
2680 char isLocal = FALSE; /* avoids uninit-var warning */
2682 char* nm = strtab + stab[j].st_name;
2683 int secno = stab[j].st_shndx;
2685 /* Figure out if we want to add it; if so, set ad to its
2686 address. Otherwise leave ad == NULL. */
2688 if (secno == SHN_COMMON) {
2690 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2692 debugBelch("COMMON symbol, size %d name %s\n",
2693 stab[j].st_size, nm);
2695 /* Pointless to do addProddableBlock() for this area,
2696 since the linker should never poke around in it. */
2699 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2700 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2702 /* and not an undefined symbol */
2703 && stab[j].st_shndx != SHN_UNDEF
2704 /* and not in a "special section" */
2705 && stab[j].st_shndx < SHN_LORESERVE
2707 /* and it's a not a section or string table or anything silly */
2708 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2709 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2710 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2713 /* Section 0 is the undefined section, hence > and not >=. */
2714 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2716 if (shdr[secno].sh_type == SHT_NOBITS) {
2717 debugBelch(" BSS symbol, size %d off %d name %s\n",
2718 stab[j].st_size, stab[j].st_value, nm);
2721 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2722 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2725 #ifdef ELF_FUNCTION_DESC
2726 /* dlsym() and the initialisation table both give us function
2727 * descriptors, so to be consistent we store function descriptors
2728 * in the symbol table */
2729 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2730 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2732 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s",
2733 ad, oc->fileName, nm ));
2738 /* And the decision is ... */
2742 oc->symbols[j] = nm;
2745 /* Ignore entirely. */
2747 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2751 IF_DEBUG(linker,debugBelch( "skipping `%s'",
2752 strtab + stab[j].st_name ));
2755 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2756 (int)ELF_ST_BIND(stab[j].st_info),
2757 (int)ELF_ST_TYPE(stab[j].st_info),
2758 (int)stab[j].st_shndx,
2759 strtab + stab[j].st_name
2762 oc->symbols[j] = NULL;
2771 /* Do ELF relocations which lack an explicit addend. All x86-linux
2772 relocations appear to be of this form. */
2774 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2775 Elf_Shdr* shdr, int shnum,
2776 Elf_Sym* stab, char* strtab )
2781 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2782 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2783 int target_shndx = shdr[shnum].sh_info;
2784 int symtab_shndx = shdr[shnum].sh_link;
2786 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2787 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2788 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d",
2789 target_shndx, symtab_shndx ));
2791 for (j = 0; j < nent; j++) {
2792 Elf_Addr offset = rtab[j].r_offset;
2793 Elf_Addr info = rtab[j].r_info;
2795 Elf_Addr P = ((Elf_Addr)targ) + offset;
2796 Elf_Word* pP = (Elf_Word*)P;
2802 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
2803 j, (void*)offset, (void*)info ));
2805 IF_DEBUG(linker,debugBelch( " ZERO" ));
2808 Elf_Sym sym = stab[ELF_R_SYM(info)];
2809 /* First see if it is a local symbol. */
2810 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2811 /* Yes, so we can get the address directly from the ELF symbol
2813 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2815 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2816 + stab[ELF_R_SYM(info)].st_value);
2819 /* No, so look up the name in our global table. */
2820 symbol = strtab + sym.st_name;
2821 S_tmp = lookupSymbol( symbol );
2822 S = (Elf_Addr)S_tmp;
2825 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
2828 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
2831 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p",
2832 (void*)P, (void*)S, (void*)A ));
2833 checkProddableBlock ( oc, pP );
2837 switch (ELF_R_TYPE(info)) {
2838 # ifdef i386_TARGET_ARCH
2839 case R_386_32: *pP = value; break;
2840 case R_386_PC32: *pP = value - P; break;
2843 errorBelch("%s: unhandled ELF relocation(Rel) type %d\n",
2844 oc->fileName, ELF_R_TYPE(info));
2852 /* Do ELF relocations for which explicit addends are supplied.
2853 sparc-solaris relocations appear to be of this form. */
2855 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2856 Elf_Shdr* shdr, int shnum,
2857 Elf_Sym* stab, char* strtab )
2862 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2863 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2864 int target_shndx = shdr[shnum].sh_info;
2865 int symtab_shndx = shdr[shnum].sh_link;
2867 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2868 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2869 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d",
2870 target_shndx, symtab_shndx ));
2872 for (j = 0; j < nent; j++) {
2873 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH) || defined(powerpc_TARGET_ARCH)
2874 /* This #ifdef only serves to avoid unused-var warnings. */
2875 Elf_Addr offset = rtab[j].r_offset;
2876 Elf_Addr P = targ + offset;
2878 Elf_Addr info = rtab[j].r_info;
2879 Elf_Addr A = rtab[j].r_addend;
2883 # if defined(sparc_TARGET_ARCH)
2884 Elf_Word* pP = (Elf_Word*)P;
2886 # elif defined(ia64_TARGET_ARCH)
2887 Elf64_Xword *pP = (Elf64_Xword *)P;
2889 # elif defined(powerpc_TARGET_ARCH)
2893 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
2894 j, (void*)offset, (void*)info,
2897 IF_DEBUG(linker,debugBelch( " ZERO" ));
2900 Elf_Sym sym = stab[ELF_R_SYM(info)];
2901 /* First see if it is a local symbol. */
2902 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2903 /* Yes, so we can get the address directly from the ELF symbol
2905 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2907 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2908 + stab[ELF_R_SYM(info)].st_value);
2909 #ifdef ELF_FUNCTION_DESC
2910 /* Make a function descriptor for this function */
2911 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2912 S = allocateFunctionDesc(S + A);
2917 /* No, so look up the name in our global table. */
2918 symbol = strtab + sym.st_name;
2919 S_tmp = lookupSymbol( symbol );
2920 S = (Elf_Addr)S_tmp;
2922 #ifdef ELF_FUNCTION_DESC
2923 /* If a function, already a function descriptor - we would
2924 have to copy it to add an offset. */
2925 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2926 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2930 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
2933 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
2936 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
2937 (void*)P, (void*)S, (void*)A ));
2938 /* checkProddableBlock ( oc, (void*)P ); */
2942 switch (ELF_R_TYPE(info)) {
2943 # if defined(sparc_TARGET_ARCH)
2944 case R_SPARC_WDISP30:
2945 w1 = *pP & 0xC0000000;
2946 w2 = (Elf_Word)((value - P) >> 2);
2947 ASSERT((w2 & 0xC0000000) == 0);
2952 w1 = *pP & 0xFFC00000;
2953 w2 = (Elf_Word)(value >> 10);
2954 ASSERT((w2 & 0xFFC00000) == 0);
2960 w2 = (Elf_Word)(value & 0x3FF);
2961 ASSERT((w2 & ~0x3FF) == 0);
2965 /* According to the Sun documentation:
2967 This relocation type resembles R_SPARC_32, except it refers to an
2968 unaligned word. That is, the word to be relocated must be treated
2969 as four separate bytes with arbitrary alignment, not as a word
2970 aligned according to the architecture requirements.
2972 (JRS: which means that freeloading on the R_SPARC_32 case
2973 is probably wrong, but hey ...)
2977 w2 = (Elf_Word)value;
2980 # elif defined(ia64_TARGET_ARCH)
2981 case R_IA64_DIR64LSB:
2982 case R_IA64_FPTR64LSB:
2985 case R_IA64_PCREL64LSB:
2988 case R_IA64_SEGREL64LSB:
2989 addr = findElfSegment(ehdrC, value);
2992 case R_IA64_GPREL22:
2993 ia64_reloc_gprel22(P, value);
2995 case R_IA64_LTOFF22:
2996 case R_IA64_LTOFF22X:
2997 case R_IA64_LTOFF_FPTR22:
2998 addr = allocateGOTEntry(value);
2999 ia64_reloc_gprel22(P, addr);
3001 case R_IA64_PCREL21B:
3002 ia64_reloc_pcrel21(P, S, oc);
3005 /* This goes with R_IA64_LTOFF22X and points to the load to
3006 * convert into a move. We don't implement relaxation. */
3008 # elif defined(powerpc_TARGET_ARCH)
3009 case R_PPC_ADDR16_LO:
3010 *(Elf32_Half*) P = value;
3013 case R_PPC_ADDR16_HI:
3014 *(Elf32_Half*) P = value >> 16;
3017 case R_PPC_ADDR16_HA:
3018 *(Elf32_Half*) P = (value + 0x8000) >> 16;
3022 *(Elf32_Word *) P = value;
3026 *(Elf32_Word *) P = value - P;
3032 if( delta << 6 >> 6 != delta )
3034 value = makeJumpIsland( oc, ELF_R_SYM(info), value );
3037 if( value == 0 || delta << 6 >> 6 != delta )
3039 barf( "Unable to make ppcJumpIsland for #%d",
3045 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3046 | (delta & 0x3fffffc);
3050 errorBelch("%s: unhandled ELF relocation(RelA) type %d\n",
3051 oc->fileName, ELF_R_TYPE(info));
3060 ocResolve_ELF ( ObjectCode* oc )
3064 Elf_Sym* stab = NULL;
3065 char* ehdrC = (char*)(oc->image);
3066 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
3067 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3068 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
3070 /* first find "the" symbol table */
3071 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
3073 /* also go find the string table */
3074 strtab = findElfSection ( ehdrC, SHT_STRTAB );
3076 if (stab == NULL || strtab == NULL) {
3077 errorBelch("%s: can't find string or symbol table", oc->fileName);
3081 /* Process the relocation sections. */
3082 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
3084 /* Skip sections called ".rel.stab". These appear to contain
3085 relocation entries that, when done, make the stabs debugging
3086 info point at the right places. We ain't interested in all
3088 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
3091 if (shdr[shnum].sh_type == SHT_REL ) {
3092 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
3093 shnum, stab, strtab );
3097 if (shdr[shnum].sh_type == SHT_RELA) {
3098 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
3099 shnum, stab, strtab );
3104 /* Free the local symbol table; we won't need it again. */
3105 freeHashTable(oc->lochash, NULL);
3108 #if defined(powerpc_TARGET_ARCH)
3109 ocFlushInstructionCache( oc );
3117 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
3118 * at the front. The following utility functions pack and unpack instructions, and
3119 * take care of the most common relocations.
3122 #ifdef ia64_TARGET_ARCH
3125 ia64_extract_instruction(Elf64_Xword *target)
3128 int slot = (Elf_Addr)target & 3;
3129 (Elf_Addr)target &= ~3;
3137 return ((w1 >> 5) & 0x1ffffffffff);
3139 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
3143 barf("ia64_extract_instruction: invalid slot %p", target);
3148 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
3150 int slot = (Elf_Addr)target & 3;
3151 (Elf_Addr)target &= ~3;
3156 *target |= value << 5;
3159 *target |= value << 46;
3160 *(target+1) |= value >> 18;
3163 *(target+1) |= value << 23;
3169 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3171 Elf64_Xword instruction;
3172 Elf64_Sxword rel_value;
3174 rel_value = value - gp_val;
3175 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3176 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3178 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3179 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3180 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3181 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3182 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3183 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3187 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3189 Elf64_Xword instruction;
3190 Elf64_Sxword rel_value;
3193 entry = allocatePLTEntry(value, oc);
3195 rel_value = (entry >> 4) - (target >> 4);
3196 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3197 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3199 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3200 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3201 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3202 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3208 * PowerPC ELF specifics
3211 #ifdef powerpc_TARGET_ARCH
3213 static int ocAllocateJumpIslands_ELF( ObjectCode *oc )
3219 ehdr = (Elf_Ehdr *) oc->image;
3220 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
3222 for( i = 0; i < ehdr->e_shnum; i++ )
3223 if( shdr[i].sh_type == SHT_SYMTAB )
3226 if( i == ehdr->e_shnum )
3228 errorBelch( "This ELF file contains no symtab" );
3232 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
3234 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
3235 shdr[i].sh_entsize, sizeof( Elf_Sym ) );
3240 return ocAllocateJumpIslands( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
3243 #endif /* powerpc */
3247 /* --------------------------------------------------------------------------
3249 * ------------------------------------------------------------------------*/
3251 #if defined(OBJFORMAT_MACHO)
3254 Support for MachO linking on Darwin/MacOS X on PowerPC chips
3255 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3257 I hereby formally apologize for the hackish nature of this code.
3258 Things that need to be done:
3259 *) implement ocVerifyImage_MachO
3260 *) add still more sanity checks.
3263 static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
3265 struct mach_header *header = (struct mach_header *) oc->image;
3266 struct load_command *lc = (struct load_command *) (header + 1);
3269 for( i = 0; i < header->ncmds; i++ )
3271 if( lc->cmd == LC_DYSYMTAB )
3273 struct dysymtab_command *dsymLC = (struct dysymtab_command *) lc;
3275 if( !ocAllocateJumpIslands( oc, dsymLC->nundefsym,
3276 dsymLC->iundefsym ) )
3279 break; // there can be only one LC_DSYMTAB
3281 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3286 static int ocVerifyImage_MachO(ObjectCode* oc)
3288 // FIXME: do some verifying here
3292 static int resolveImports(
3295 struct symtab_command *symLC,
3296 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3297 unsigned long *indirectSyms,
3298 struct nlist *nlist)
3302 for(i=0;i*4<sect->size;i++)
3304 // according to otool, reserved1 contains the first index into the indirect symbol table
3305 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3306 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3309 if((symbol->n_type & N_TYPE) == N_UNDF
3310 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3311 addr = (void*) (symbol->n_value);
3312 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3315 addr = lookupSymbol(nm);
3318 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3322 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3323 ((void**)(image + sect->offset))[i] = addr;
3329 static char* relocateAddress(
3332 struct section* sections,
3333 unsigned long address)
3336 for(i = 0; i < nSections; i++)
3338 if(sections[i].addr <= address
3339 && address < sections[i].addr + sections[i].size)
3341 return oc->image + sections[i].offset + address - sections[i].addr;
3344 barf("Invalid Mach-O file:"
3345 "Address out of bounds while relocating object file");
3349 static int relocateSection(
3352 struct symtab_command *symLC, struct nlist *nlist,
3353 int nSections, struct section* sections, struct section *sect)
3355 struct relocation_info *relocs;
3358 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3360 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3364 relocs = (struct relocation_info*) (image + sect->reloff);
3368 if(relocs[i].r_address & R_SCATTERED)
3370 struct scattered_relocation_info *scat =
3371 (struct scattered_relocation_info*) &relocs[i];
3375 if(scat->r_length == 2)
3377 unsigned long word = 0;
3378 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
3379 checkProddableBlock(oc,wordPtr);
3381 // Step 1: Figure out what the relocated value should be
3382 if(scat->r_type == GENERIC_RELOC_VANILLA)
3384 word = *wordPtr + (unsigned long) relocateAddress(
3391 else if(scat->r_type == PPC_RELOC_SECTDIFF
3392 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
3393 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
3394 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3396 struct scattered_relocation_info *pair =
3397 (struct scattered_relocation_info*) &relocs[i+1];
3399 if(!pair->r_scattered || pair->r_type != PPC_RELOC_PAIR)
3400 barf("Invalid Mach-O file: "
3401 "PPC_RELOC_*_SECTDIFF not followed by PPC_RELOC_PAIR");
3403 word = (unsigned long)
3404 (relocateAddress(oc, nSections, sections, scat->r_value)
3405 - relocateAddress(oc, nSections, sections, pair->r_value));
3408 else if(scat->r_type == PPC_RELOC_HI16
3409 || scat->r_type == PPC_RELOC_LO16
3410 || scat->r_type == PPC_RELOC_HA16
3411 || scat->r_type == PPC_RELOC_LO14)
3412 { // these are generated by label+offset things
3413 struct relocation_info *pair = &relocs[i+1];
3414 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
3415 barf("Invalid Mach-O file: "
3416 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
3418 if(scat->r_type == PPC_RELOC_LO16)
3420 word = ((unsigned short*) wordPtr)[1];
3421 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3423 else if(scat->r_type == PPC_RELOC_LO14)
3425 barf("Unsupported Relocation: PPC_RELOC_LO14");
3426 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
3427 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3429 else if(scat->r_type == PPC_RELOC_HI16)
3431 word = ((unsigned short*) wordPtr)[1] << 16;
3432 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3434 else if(scat->r_type == PPC_RELOC_HA16)
3436 word = ((unsigned short*) wordPtr)[1] << 16;
3437 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3441 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
3447 continue; // ignore the others
3449 if(scat->r_type == GENERIC_RELOC_VANILLA
3450 || scat->r_type == PPC_RELOC_SECTDIFF)
3454 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
3456 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3458 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
3460 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3462 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
3464 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3465 + ((word & (1<<15)) ? 1 : 0);
3470 continue; // FIXME: I hope it's OK to ignore all the others.
3474 struct relocation_info *reloc = &relocs[i];
3475 if(reloc->r_pcrel && !reloc->r_extern)
3478 if(reloc->r_length == 2)
3480 unsigned long word = 0;
3481 unsigned long jumpIsland = 0;
3482 long offsetToJumpIsland;
3484 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3485 checkProddableBlock(oc,wordPtr);
3487 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3491 else if(reloc->r_type == PPC_RELOC_LO16)
3493 word = ((unsigned short*) wordPtr)[1];
3494 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3496 else if(reloc->r_type == PPC_RELOC_HI16)
3498 word = ((unsigned short*) wordPtr)[1] << 16;
3499 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3501 else if(reloc->r_type == PPC_RELOC_HA16)
3503 word = ((unsigned short*) wordPtr)[1] << 16;
3504 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3506 else if(reloc->r_type == PPC_RELOC_BR24)
3509 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
3513 if(!reloc->r_extern)
3516 sections[reloc->r_symbolnum-1].offset
3517 - sections[reloc->r_symbolnum-1].addr
3524 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3525 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3526 unsigned long symbolAddress = (unsigned long) (lookupSymbol(nm));
3529 errorBelch("\nunknown symbol `%s'", nm);
3535 // In the .o file, this should be a relative jump to NULL
3536 // and we'll change it to a jump to a relative jump to the symbol
3537 ASSERT(-word == reloc->r_address);
3538 word = symbolAddress;
3539 jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,word);
3540 word -= ((long)image) + sect->offset + reloc->r_address;
3543 offsetToJumpIsland = jumpIsland
3544 - (((long)image) + sect->offset + reloc->r_address);
3549 word += symbolAddress;
3553 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3558 else if(reloc->r_type == PPC_RELOC_LO16)
3560 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3563 else if(reloc->r_type == PPC_RELOC_HI16)
3565 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3568 else if(reloc->r_type == PPC_RELOC_HA16)
3570 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3571 + ((word & (1<<15)) ? 1 : 0);
3574 else if(reloc->r_type == PPC_RELOC_BR24)
3576 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3578 // The branch offset is too large.
3579 // Therefore, we try to use a jump island.
3581 barf("unconditional relative branch out of range: "
3582 "no jump island available");
3584 word = offsetToJumpIsland;
3585 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3586 barf("unconditional relative branch out of range: "
3587 "jump island out of range");
3589 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3593 barf("\nunknown relocation %d",reloc->r_type);
3600 static int ocGetNames_MachO(ObjectCode* oc)
3602 char *image = (char*) oc->image;
3603 struct mach_header *header = (struct mach_header*) image;
3604 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3605 unsigned i,curSymbol;
3606 struct segment_command *segLC = NULL;
3607 struct section *sections;
3608 struct symtab_command *symLC = NULL;
3609 struct dysymtab_command *dsymLC = NULL;
3610 struct nlist *nlist;
3611 unsigned long commonSize = 0;
3612 char *commonStorage = NULL;
3613 unsigned long commonCounter;
3615 for(i=0;i<header->ncmds;i++)
3617 if(lc->cmd == LC_SEGMENT)
3618 segLC = (struct segment_command*) lc;
3619 else if(lc->cmd == LC_SYMTAB)
3620 symLC = (struct symtab_command*) lc;
3621 else if(lc->cmd == LC_DYSYMTAB)
3622 dsymLC = (struct dysymtab_command*) lc;
3623 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3626 sections = (struct section*) (segLC+1);
3627 nlist = (struct nlist*) (image + symLC->symoff);
3629 for(i=0;i<segLC->nsects;i++)
3631 if(sections[i].size == 0)
3634 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
3636 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
3637 "ocGetNames_MachO(common symbols)");
3638 sections[i].offset = zeroFillArea - image;
3641 if(!strcmp(sections[i].sectname,"__text"))
3642 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3643 (void*) (image + sections[i].offset),
3644 (void*) (image + sections[i].offset + sections[i].size));
3645 else if(!strcmp(sections[i].sectname,"__const"))
3646 addSection(oc, SECTIONKIND_RWDATA,
3647 (void*) (image + sections[i].offset),
3648 (void*) (image + sections[i].offset + sections[i].size));
3649 else if(!strcmp(sections[i].sectname,"__data"))
3650 addSection(oc, SECTIONKIND_RWDATA,
3651 (void*) (image + sections[i].offset),
3652 (void*) (image + sections[i].offset + sections[i].size));
3653 else if(!strcmp(sections[i].sectname,"__bss")
3654 || !strcmp(sections[i].sectname,"__common"))
3655 addSection(oc, SECTIONKIND_RWDATA,
3656 (void*) (image + sections[i].offset),
3657 (void*) (image + sections[i].offset + sections[i].size));
3659 addProddableBlock(oc, (void*) (image + sections[i].offset),
3663 // count external symbols defined here
3667 for(i = dsymLC->iextdefsym;
3668 i < dsymLC->iextdefsym + dsymLC->nextdefsym;
3671 if((nlist[i].n_type & N_TYPE) == N_SECT)
3677 for(i=0;i<symLC->nsyms;i++)
3679 if((nlist[i].n_type & N_TYPE) == N_UNDF
3680 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3682 commonSize += nlist[i].n_value;
3687 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3688 "ocGetNames_MachO(oc->symbols)");
3692 // insert symbols into hash table
3693 for(i = dsymLC->iextdefsym, curSymbol = 0;
3694 i < dsymLC->iextdefsym + dsymLC->nextdefsym;
3697 if((nlist[i].n_type & N_TYPE) == N_SECT)
3699 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3700 ghciInsertStrHashTable(oc->fileName, symhash, nm,
3702 + sections[nlist[i].n_sect-1].offset
3703 - sections[nlist[i].n_sect-1].addr
3704 + nlist[i].n_value);
3705 oc->symbols[curSymbol++] = nm;
3709 // insert local symbols into lochash
3710 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3712 if((nlist[i].n_type & N_TYPE) == N_SECT)
3714 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3715 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm,
3717 + sections[nlist[i].n_sect-1].offset
3718 - sections[nlist[i].n_sect-1].addr
3719 + nlist[i].n_value);
3724 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3725 commonCounter = (unsigned long)commonStorage;
3728 for(i=0;i<symLC->nsyms;i++)
3730 if((nlist[i].n_type & N_TYPE) == N_UNDF
3731 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3733 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3734 unsigned long sz = nlist[i].n_value;
3736 nlist[i].n_value = commonCounter;
3738 ghciInsertStrHashTable(oc->fileName, symhash, nm,
3739 (void*)commonCounter);
3740 oc->symbols[curSymbol++] = nm;
3742 commonCounter += sz;
3749 static int ocResolve_MachO(ObjectCode* oc)
3751 char *image = (char*) oc->image;
3752 struct mach_header *header = (struct mach_header*) image;
3753 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3755 struct segment_command *segLC = NULL;
3756 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3757 struct symtab_command *symLC = NULL;
3758 struct dysymtab_command *dsymLC = NULL;
3759 struct nlist *nlist;
3761 for(i=0;i<header->ncmds;i++)
3763 if(lc->cmd == LC_SEGMENT)
3764 segLC = (struct segment_command*) lc;
3765 else if(lc->cmd == LC_SYMTAB)
3766 symLC = (struct symtab_command*) lc;
3767 else if(lc->cmd == LC_DYSYMTAB)
3768 dsymLC = (struct dysymtab_command*) lc;
3769 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3772 sections = (struct section*) (segLC+1);
3773 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
3776 for(i=0;i<segLC->nsects;i++)
3778 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3779 la_ptrs = §ions[i];
3780 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3781 nl_ptrs = §ions[i];
3786 unsigned long *indirectSyms
3787 = (unsigned long*) (image + dsymLC->indirectsymoff);
3790 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3793 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3797 for(i=0;i<segLC->nsects;i++)
3799 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
3803 /* Free the local symbol table; we won't need it again. */
3804 freeHashTable(oc->lochash, NULL);
3807 #if defined (powerpc_TARGET_ARCH)
3808 ocFlushInstructionCache( oc );
3815 * The Mach-O object format uses leading underscores. But not everywhere.
3816 * There is a small number of runtime support functions defined in
3817 * libcc_dynamic.a whose name does not have a leading underscore.
3818 * As a consequence, we can't get their address from C code.
3819 * We have to use inline assembler just to take the address of a function.
3823 static void machoInitSymbolsWithoutUnderscore()
3825 extern void* symbolsWithoutUnderscore[];
3826 void **p = symbolsWithoutUnderscore;
3827 __asm__ volatile(".data\n_symbolsWithoutUnderscore:");
3831 __asm__ volatile(".long " # x);
3833 RTS_MACHO_NOUNDERLINE_SYMBOLS
3835 __asm__ volatile(".text");
3839 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
3841 RTS_MACHO_NOUNDERLINE_SYMBOLS