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) || defined(linux_TARGET_OS)
66 #if defined(openbsd_TARGET_OS) || defined(linux_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 \
605 #elif defined(ia64_TARGET_ARCH)
606 #define RTS_LIBGCC_SYMBOLS \
614 #define RTS_LIBGCC_SYMBOLS
617 #ifdef darwin_TARGET_OS
618 // Symbols that don't have a leading underscore
619 // on Mac OS X. They have to receive special treatment,
620 // see machoInitSymbolsWithoutUnderscore()
621 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
626 /* entirely bogus claims about types of these symbols */
627 #define Sym(vvv) extern void vvv(void);
628 #define SymX(vvv) /**/
629 #define SymX_redirect(vvv,xxx) /**/
633 RTS_POSIX_ONLY_SYMBOLS
634 RTS_MINGW_ONLY_SYMBOLS
635 RTS_CYGWIN_ONLY_SYMBOLS
641 #ifdef LEADING_UNDERSCORE
642 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
644 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
647 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
649 #define SymX(vvv) Sym(vvv)
651 // SymX_redirect allows us to redirect references to one symbol to
652 // another symbol. See newCAF/newDynCAF for an example.
653 #define SymX_redirect(vvv,xxx) \
654 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
657 static RtsSymbolVal rtsSyms[] = {
661 RTS_POSIX_ONLY_SYMBOLS
662 RTS_MINGW_ONLY_SYMBOLS
663 RTS_CYGWIN_ONLY_SYMBOLS
665 { 0, 0 } /* sentinel */
668 /* -----------------------------------------------------------------------------
669 * Insert symbols into hash tables, checking for duplicates.
671 static void ghciInsertStrHashTable ( char* obj_name,
677 if (lookupHashTable(table, (StgWord)key) == NULL)
679 insertStrHashTable(table, (StgWord)key, data);
684 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
686 "whilst processing object file\n"
688 "This could be caused by:\n"
689 " * Loading two different object files which export the same symbol\n"
690 " * Specifying the same object file twice on the GHCi command line\n"
691 " * An incorrect `package.conf' entry, causing some object to be\n"
693 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
702 /* -----------------------------------------------------------------------------
703 * initialize the object linker
707 static int linker_init_done = 0 ;
709 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
710 static void *dl_prog_handle;
713 /* dlopen(NULL,..) doesn't work so we grab libc explicitly */
714 #if defined(openbsd_TARGET_OS)
715 static void *dl_libc_handle;
723 /* Make initLinker idempotent, so we can call it
724 before evey relevant operation; that means we
725 don't need to initialise the linker separately */
726 if (linker_init_done == 1) { return; } else {
727 linker_init_done = 1;
730 symhash = allocStrHashTable();
732 /* populate the symbol table with stuff from the RTS */
733 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
734 ghciInsertStrHashTable("(GHCi built-in symbols)",
735 symhash, sym->lbl, sym->addr);
737 # if defined(OBJFORMAT_MACHO)
738 machoInitSymbolsWithoutUnderscore();
741 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
742 # if defined(RTLD_DEFAULT)
743 dl_prog_handle = RTLD_DEFAULT;
745 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
746 # if defined(openbsd_TARGET_OS)
747 dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
749 # endif // RTLD_DEFAULT
753 /* -----------------------------------------------------------------------------
754 * Loading DLL or .so dynamic libraries
755 * -----------------------------------------------------------------------------
757 * Add a DLL from which symbols may be found. In the ELF case, just
758 * do RTLD_GLOBAL-style add, so no further messing around needs to
759 * happen in order that symbols in the loaded .so are findable --
760 * lookupSymbol() will subsequently see them by dlsym on the program's
761 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
763 * In the PEi386 case, open the DLLs and put handles to them in a
764 * linked list. When looking for a symbol, try all handles in the
765 * list. This means that we need to load even DLLs that are guaranteed
766 * to be in the ghc.exe image already, just so we can get a handle
767 * to give to loadSymbol, so that we can find the symbols. For such
768 * libraries, the LoadLibrary call should be a no-op except for returning
773 #if defined(OBJFORMAT_PEi386)
774 /* A record for storing handles into DLLs. */
779 struct _OpenedDLL* next;
784 /* A list thereof. */
785 static OpenedDLL* opened_dlls = NULL;
789 addDLL( char *dll_name )
791 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
792 /* ------------------- ELF DLL loader ------------------- */
798 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
801 /* dlopen failed; return a ptr to the error msg. */
803 if (errmsg == NULL) errmsg = "addDLL: unknown error";
810 # elif defined(OBJFORMAT_PEi386)
811 /* ------------------- Win32 DLL loader ------------------- */
819 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
821 /* See if we've already got it, and ignore if so. */
822 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
823 if (0 == strcmp(o_dll->name, dll_name))
827 /* The file name has no suffix (yet) so that we can try
828 both foo.dll and foo.drv
830 The documentation for LoadLibrary says:
831 If no file name extension is specified in the lpFileName
832 parameter, the default library extension .dll is
833 appended. However, the file name string can include a trailing
834 point character (.) to indicate that the module name has no
837 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
838 sprintf(buf, "%s.DLL", dll_name);
839 instance = LoadLibrary(buf);
840 if (instance == NULL) {
841 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
842 instance = LoadLibrary(buf);
843 if (instance == NULL) {
846 /* LoadLibrary failed; return a ptr to the error msg. */
847 return "addDLL: unknown error";
852 /* Add this DLL to the list of DLLs in which to search for symbols. */
853 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
854 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
855 strcpy(o_dll->name, dll_name);
856 o_dll->instance = instance;
857 o_dll->next = opened_dlls;
862 barf("addDLL: not implemented on this platform");
866 /* -----------------------------------------------------------------------------
867 * lookup a symbol in the hash table
870 lookupSymbol( char *lbl )
874 ASSERT(symhash != NULL);
875 val = lookupStrHashTable(symhash, lbl);
878 # if defined(OBJFORMAT_ELF)
879 # if defined(openbsd_TARGET_OS)
880 val = dlsym(dl_prog_handle, lbl);
881 return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
882 # else /* not openbsd */
883 return dlsym(dl_prog_handle, lbl);
885 # elif defined(OBJFORMAT_MACHO)
886 if(NSIsSymbolNameDefined(lbl)) {
887 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
888 return NSAddressOfSymbol(symbol);
892 # elif defined(OBJFORMAT_PEi386)
895 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
896 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
898 /* HACK: if the name has an initial underscore, try stripping
899 it off & look that up first. I've yet to verify whether there's
900 a Rule that governs whether an initial '_' *should always* be
901 stripped off when mapping from import lib name to the DLL name.
903 sym = GetProcAddress(o_dll->instance, (lbl+1));
905 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
909 sym = GetProcAddress(o_dll->instance, lbl);
911 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
926 __attribute((unused))
928 lookupLocalSymbol( ObjectCode* oc, char *lbl )
932 val = lookupStrHashTable(oc->lochash, lbl);
942 /* -----------------------------------------------------------------------------
943 * Debugging aid: look in GHCi's object symbol tables for symbols
944 * within DELTA bytes of the specified address, and show their names.
947 void ghci_enquire ( char* addr );
949 void ghci_enquire ( char* addr )
954 const int DELTA = 64;
959 for (oc = objects; oc; oc = oc->next) {
960 for (i = 0; i < oc->n_symbols; i++) {
961 sym = oc->symbols[i];
962 if (sym == NULL) continue;
963 // debugBelch("enquire %p %p\n", sym, oc->lochash);
965 if (oc->lochash != NULL) {
966 a = lookupStrHashTable(oc->lochash, sym);
969 a = lookupStrHashTable(symhash, sym);
972 // debugBelch("ghci_enquire: can't find %s\n", sym);
974 else if (addr-DELTA <= a && a <= addr+DELTA) {
975 debugBelch("%p + %3d == `%s'\n", addr, a - addr, sym);
982 #ifdef ia64_TARGET_ARCH
983 static unsigned int PLTSize(void);
986 /* -----------------------------------------------------------------------------
987 * Load an obj (populate the global symbol table, but don't resolve yet)
989 * Returns: 1 if ok, 0 on error.
992 loadObj( char *path )
999 void *map_addr = NULL;
1006 /* debugBelch("loadObj %s\n", path ); */
1008 /* Check that we haven't already loaded this object.
1009 Ignore requests to load multiple times */
1013 for (o = objects; o; o = o->next) {
1014 if (0 == strcmp(o->fileName, path)) {
1016 break; /* don't need to search further */
1020 IF_DEBUG(linker, debugBelch(
1021 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1022 "same object file twice:\n"
1024 "GHCi will ignore this, but be warned.\n"
1026 return 1; /* success */
1030 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1032 # if defined(OBJFORMAT_ELF)
1033 oc->formatName = "ELF";
1034 # elif defined(OBJFORMAT_PEi386)
1035 oc->formatName = "PEi386";
1036 # elif defined(OBJFORMAT_MACHO)
1037 oc->formatName = "Mach-O";
1040 barf("loadObj: not implemented on this platform");
1043 r = stat(path, &st);
1044 if (r == -1) { return 0; }
1046 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1047 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1048 strcpy(oc->fileName, path);
1050 oc->fileSize = st.st_size;
1052 oc->sections = NULL;
1053 oc->lochash = allocStrHashTable();
1054 oc->proddables = NULL;
1056 /* chain it onto the list of objects */
1061 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1063 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1065 #if defined(openbsd_TARGET_OS)
1066 fd = open(path, O_RDONLY, S_IRUSR);
1068 fd = open(path, O_RDONLY);
1071 barf("loadObj: can't open `%s'", path);
1073 pagesize = getpagesize();
1075 #ifdef ia64_TARGET_ARCH
1076 /* The PLT needs to be right before the object */
1077 n = ROUND_UP(PLTSize(), pagesize);
1078 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1079 if (oc->plt == MAP_FAILED)
1080 barf("loadObj: can't allocate PLT");
1083 map_addr = oc->plt + n;
1086 n = ROUND_UP(oc->fileSize, pagesize);
1087 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1088 if (oc->image == MAP_FAILED)
1089 barf("loadObj: can't map `%s'", path);
1093 #else /* !USE_MMAP */
1095 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1097 /* load the image into memory */
1098 f = fopen(path, "rb");
1100 barf("loadObj: can't read `%s'", path);
1102 n = fread ( oc->image, 1, oc->fileSize, f );
1103 if (n != oc->fileSize)
1104 barf("loadObj: error whilst reading `%s'", path);
1108 #endif /* USE_MMAP */
1110 # if defined(OBJFORMAT_MACHO)
1111 r = ocAllocateJumpIslands_MachO ( oc );
1112 if (!r) { return r; }
1113 # elif defined(OBJFORMAT_ELF) && defined(powerpc_TARGET_ARCH)
1114 r = ocAllocateJumpIslands_ELF ( oc );
1115 if (!r) { return r; }
1118 /* verify the in-memory image */
1119 # if defined(OBJFORMAT_ELF)
1120 r = ocVerifyImage_ELF ( oc );
1121 # elif defined(OBJFORMAT_PEi386)
1122 r = ocVerifyImage_PEi386 ( oc );
1123 # elif defined(OBJFORMAT_MACHO)
1124 r = ocVerifyImage_MachO ( oc );
1126 barf("loadObj: no verify method");
1128 if (!r) { return r; }
1130 /* build the symbol list for this image */
1131 # if defined(OBJFORMAT_ELF)
1132 r = ocGetNames_ELF ( oc );
1133 # elif defined(OBJFORMAT_PEi386)
1134 r = ocGetNames_PEi386 ( oc );
1135 # elif defined(OBJFORMAT_MACHO)
1136 r = ocGetNames_MachO ( oc );
1138 barf("loadObj: no getNames method");
1140 if (!r) { return r; }
1142 /* loaded, but not resolved yet */
1143 oc->status = OBJECT_LOADED;
1148 /* -----------------------------------------------------------------------------
1149 * resolve all the currently unlinked objects in memory
1151 * Returns: 1 if ok, 0 on error.
1161 for (oc = objects; oc; oc = oc->next) {
1162 if (oc->status != OBJECT_RESOLVED) {
1163 # if defined(OBJFORMAT_ELF)
1164 r = ocResolve_ELF ( oc );
1165 # elif defined(OBJFORMAT_PEi386)
1166 r = ocResolve_PEi386 ( oc );
1167 # elif defined(OBJFORMAT_MACHO)
1168 r = ocResolve_MachO ( oc );
1170 barf("resolveObjs: not implemented on this platform");
1172 if (!r) { return r; }
1173 oc->status = OBJECT_RESOLVED;
1179 /* -----------------------------------------------------------------------------
1180 * delete an object from the pool
1183 unloadObj( char *path )
1185 ObjectCode *oc, *prev;
1187 ASSERT(symhash != NULL);
1188 ASSERT(objects != NULL);
1193 for (oc = objects; oc; prev = oc, oc = oc->next) {
1194 if (!strcmp(oc->fileName,path)) {
1196 /* Remove all the mappings for the symbols within this
1201 for (i = 0; i < oc->n_symbols; i++) {
1202 if (oc->symbols[i] != NULL) {
1203 removeStrHashTable(symhash, oc->symbols[i], NULL);
1211 prev->next = oc->next;
1214 /* We're going to leave this in place, in case there are
1215 any pointers from the heap into it: */
1216 /* stgFree(oc->image); */
1217 stgFree(oc->fileName);
1218 stgFree(oc->symbols);
1219 stgFree(oc->sections);
1220 /* The local hash table should have been freed at the end
1221 of the ocResolve_ call on it. */
1222 ASSERT(oc->lochash == NULL);
1228 errorBelch("unloadObj: can't find `%s' to unload", path);
1232 /* -----------------------------------------------------------------------------
1233 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1234 * which may be prodded during relocation, and abort if we try and write
1235 * outside any of these.
1237 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1240 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1241 /* debugBelch("aPB %p %p %d\n", oc, start, size); */
1245 pb->next = oc->proddables;
1246 oc->proddables = pb;
1249 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1252 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1253 char* s = (char*)(pb->start);
1254 char* e = s + pb->size - 1;
1255 char* a = (char*)addr;
1256 /* Assumes that the biggest fixup involves a 4-byte write. This
1257 probably needs to be changed to 8 (ie, +7) on 64-bit
1259 if (a >= s && (a+3) <= e) return;
1261 barf("checkProddableBlock: invalid fixup in runtime linker");
1264 /* -----------------------------------------------------------------------------
1265 * Section management.
1267 static void addSection ( ObjectCode* oc, SectionKind kind,
1268 void* start, void* end )
1270 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1274 s->next = oc->sections;
1277 debugBelch("addSection: %p-%p (size %d), kind %d\n",
1278 start, ((char*)end)-1, end - start + 1, kind );
1283 /* --------------------------------------------------------------------------
1284 * PowerPC specifics (jump islands)
1285 * ------------------------------------------------------------------------*/
1287 #if defined(powerpc_TARGET_ARCH)
1290 ocAllocateJumpIslands
1292 Allocate additional space at the end of the object file image to make room
1295 PowerPC relative branch instructions have a 24 bit displacement field.
1296 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
1297 If a particular imported symbol is outside this range, we have to redirect
1298 the jump to a short piece of new code that just loads the 32bit absolute
1299 address and jumps there.
1300 This function just allocates space for one 16 byte ppcJumpIsland for every
1301 undefined symbol in the object file. The code for the islands is filled in by
1302 makeJumpIsland below.
1305 static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first )
1312 #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined
1314 // round up to the nearest 4
1315 aligned = (oc->fileSize + 3) & ~3;
1317 oc->image = stgReallocBytes( oc->image,
1318 aligned + sizeof( ppcJumpIsland ) * count,
1319 "ocAllocateJumpIslands" );
1320 oc->jump_islands = (ppcJumpIsland *) (((char *) oc->image) + aligned);
1321 memset( oc->jump_islands, 0, sizeof( ppcJumpIsland ) * count );
1324 oc->jump_islands = NULL;
1326 oc->island_start_symbol = first;
1327 oc->n_islands = count;
1332 static unsigned long makeJumpIsland( ObjectCode* oc,
1333 unsigned long symbolNumber,
1334 unsigned long target )
1336 ppcJumpIsland *island;
1338 if( symbolNumber < oc->island_start_symbol ||
1339 symbolNumber - oc->island_start_symbol > oc->n_islands)
1342 island = &oc->jump_islands[symbolNumber - oc->island_start_symbol];
1344 // lis r12, hi16(target)
1345 island->lis_r12 = 0x3d80;
1346 island->hi_addr = target >> 16;
1348 // ori r12, r12, lo16(target)
1349 island->ori_r12_r12 = 0x618c;
1350 island->lo_addr = target & 0xffff;
1353 island->mtctr_r12 = 0x7d8903a6;
1356 island->bctr = 0x4e800420;
1358 return (unsigned long) island;
1362 ocFlushInstructionCache
1364 Flush the data & instruction caches.
1365 Because the PPC has split data/instruction caches, we have to
1366 do that whenever we modify code at runtime.
1369 static void ocFlushInstructionCache( ObjectCode *oc )
1371 int n = (oc->fileSize + sizeof( ppcJumpIsland ) * oc->n_islands + 3) / 4;
1372 unsigned long *p = (unsigned long *) oc->image;
1376 __asm__ volatile ( "dcbf 0,%0\n\t"
1384 __asm__ volatile ( "sync\n\t"
1390 /* --------------------------------------------------------------------------
1391 * PEi386 specifics (Win32 targets)
1392 * ------------------------------------------------------------------------*/
1394 /* The information for this linker comes from
1395 Microsoft Portable Executable
1396 and Common Object File Format Specification
1397 revision 5.1 January 1998
1398 which SimonM says comes from the MS Developer Network CDs.
1400 It can be found there (on older CDs), but can also be found
1403 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1405 (this is Rev 6.0 from February 1999).
1407 Things move, so if that fails, try searching for it via
1409 http://www.google.com/search?q=PE+COFF+specification
1411 The ultimate reference for the PE format is the Winnt.h
1412 header file that comes with the Platform SDKs; as always,
1413 implementations will drift wrt their documentation.
1415 A good background article on the PE format is Matt Pietrek's
1416 March 1994 article in Microsoft System Journal (MSJ)
1417 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1418 Win32 Portable Executable File Format." The info in there
1419 has recently been updated in a two part article in
1420 MSDN magazine, issues Feb and March 2002,
1421 "Inside Windows: An In-Depth Look into the Win32 Portable
1422 Executable File Format"
1424 John Levine's book "Linkers and Loaders" contains useful
1429 #if defined(OBJFORMAT_PEi386)
1433 typedef unsigned char UChar;
1434 typedef unsigned short UInt16;
1435 typedef unsigned int UInt32;
1442 UInt16 NumberOfSections;
1443 UInt32 TimeDateStamp;
1444 UInt32 PointerToSymbolTable;
1445 UInt32 NumberOfSymbols;
1446 UInt16 SizeOfOptionalHeader;
1447 UInt16 Characteristics;
1451 #define sizeof_COFF_header 20
1458 UInt32 VirtualAddress;
1459 UInt32 SizeOfRawData;
1460 UInt32 PointerToRawData;
1461 UInt32 PointerToRelocations;
1462 UInt32 PointerToLinenumbers;
1463 UInt16 NumberOfRelocations;
1464 UInt16 NumberOfLineNumbers;
1465 UInt32 Characteristics;
1469 #define sizeof_COFF_section 40
1476 UInt16 SectionNumber;
1479 UChar NumberOfAuxSymbols;
1483 #define sizeof_COFF_symbol 18
1488 UInt32 VirtualAddress;
1489 UInt32 SymbolTableIndex;
1494 #define sizeof_COFF_reloc 10
1497 /* From PE spec doc, section 3.3.2 */
1498 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1499 windows.h -- for the same purpose, but I want to know what I'm
1501 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1502 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1503 #define MYIMAGE_FILE_DLL 0x2000
1504 #define MYIMAGE_FILE_SYSTEM 0x1000
1505 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1506 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1507 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1509 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1510 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1511 #define MYIMAGE_SYM_CLASS_STATIC 3
1512 #define MYIMAGE_SYM_UNDEFINED 0
1514 /* From PE spec doc, section 4.1 */
1515 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1516 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1517 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1519 /* From PE spec doc, section 5.2.1 */
1520 #define MYIMAGE_REL_I386_DIR32 0x0006
1521 #define MYIMAGE_REL_I386_REL32 0x0014
1524 /* We use myindex to calculate array addresses, rather than
1525 simply doing the normal subscript thing. That's because
1526 some of the above structs have sizes which are not
1527 a whole number of words. GCC rounds their sizes up to a
1528 whole number of words, which means that the address calcs
1529 arising from using normal C indexing or pointer arithmetic
1530 are just plain wrong. Sigh.
1533 myindex ( int scale, void* base, int index )
1536 ((UChar*)base) + scale * index;
1541 printName ( UChar* name, UChar* strtab )
1543 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1544 UInt32 strtab_offset = * (UInt32*)(name+4);
1545 debugBelch("%s", strtab + strtab_offset );
1548 for (i = 0; i < 8; i++) {
1549 if (name[i] == 0) break;
1550 debugBelch("%c", name[i] );
1557 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1559 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1560 UInt32 strtab_offset = * (UInt32*)(name+4);
1561 strncpy ( dst, strtab+strtab_offset, dstSize );
1567 if (name[i] == 0) break;
1577 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1580 /* If the string is longer than 8 bytes, look in the
1581 string table for it -- this will be correctly zero terminated.
1583 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1584 UInt32 strtab_offset = * (UInt32*)(name+4);
1585 return ((UChar*)strtab) + strtab_offset;
1587 /* Otherwise, if shorter than 8 bytes, return the original,
1588 which by defn is correctly terminated.
1590 if (name[7]==0) return name;
1591 /* The annoying case: 8 bytes. Copy into a temporary
1592 (which is never freed ...)
1594 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1596 strncpy(newstr,name,8);
1602 /* Just compares the short names (first 8 chars) */
1603 static COFF_section *
1604 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1608 = (COFF_header*)(oc->image);
1609 COFF_section* sectab
1611 ((UChar*)(oc->image))
1612 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1614 for (i = 0; i < hdr->NumberOfSections; i++) {
1617 COFF_section* section_i
1619 myindex ( sizeof_COFF_section, sectab, i );
1620 n1 = (UChar*) &(section_i->Name);
1622 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1623 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1624 n1[6]==n2[6] && n1[7]==n2[7])
1633 zapTrailingAtSign ( UChar* sym )
1635 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1637 if (sym[0] == 0) return;
1639 while (sym[i] != 0) i++;
1642 while (j > 0 && my_isdigit(sym[j])) j--;
1643 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1649 ocVerifyImage_PEi386 ( ObjectCode* oc )
1654 COFF_section* sectab;
1655 COFF_symbol* symtab;
1657 /* debugBelch("\nLOADING %s\n", oc->fileName); */
1658 hdr = (COFF_header*)(oc->image);
1659 sectab = (COFF_section*) (
1660 ((UChar*)(oc->image))
1661 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1663 symtab = (COFF_symbol*) (
1664 ((UChar*)(oc->image))
1665 + hdr->PointerToSymbolTable
1667 strtab = ((UChar*)symtab)
1668 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1670 if (hdr->Machine != 0x14c) {
1671 errorBelch("Not x86 PEi386");
1674 if (hdr->SizeOfOptionalHeader != 0) {
1675 errorBelch("PEi386 with nonempty optional header");
1678 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1679 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1680 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1681 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1682 errorBelch("Not a PEi386 object file");
1685 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1686 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1687 errorBelch("Invalid PEi386 word size or endiannness: %d",
1688 (int)(hdr->Characteristics));
1691 /* If the string table size is way crazy, this might indicate that
1692 there are more than 64k relocations, despite claims to the
1693 contrary. Hence this test. */
1694 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
1696 if ( (*(UInt32*)strtab) > 600000 ) {
1697 /* Note that 600k has no special significance other than being
1698 big enough to handle the almost-2MB-sized lumps that
1699 constitute HSwin32*.o. */
1700 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
1705 /* No further verification after this point; only debug printing. */
1707 IF_DEBUG(linker, i=1);
1708 if (i == 0) return 1;
1710 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1711 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1712 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1715 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1716 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1717 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1718 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1719 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1720 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1721 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1723 /* Print the section table. */
1725 for (i = 0; i < hdr->NumberOfSections; i++) {
1727 COFF_section* sectab_i
1729 myindex ( sizeof_COFF_section, sectab, i );
1736 printName ( sectab_i->Name, strtab );
1746 sectab_i->VirtualSize,
1747 sectab_i->VirtualAddress,
1748 sectab_i->SizeOfRawData,
1749 sectab_i->PointerToRawData,
1750 sectab_i->NumberOfRelocations,
1751 sectab_i->PointerToRelocations,
1752 sectab_i->PointerToRawData
1754 reltab = (COFF_reloc*) (
1755 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1758 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1759 /* If the relocation field (a short) has overflowed, the
1760 * real count can be found in the first reloc entry.
1762 * See Section 4.1 (last para) of the PE spec (rev6.0).
1764 COFF_reloc* rel = (COFF_reloc*)
1765 myindex ( sizeof_COFF_reloc, reltab, 0 );
1766 noRelocs = rel->VirtualAddress;
1769 noRelocs = sectab_i->NumberOfRelocations;
1773 for (; j < noRelocs; j++) {
1775 COFF_reloc* rel = (COFF_reloc*)
1776 myindex ( sizeof_COFF_reloc, reltab, j );
1778 " type 0x%-4x vaddr 0x%-8x name `",
1780 rel->VirtualAddress );
1781 sym = (COFF_symbol*)
1782 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1783 /* Hmm..mysterious looking offset - what's it for? SOF */
1784 printName ( sym->Name, strtab -10 );
1791 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
1792 debugBelch("---START of string table---\n");
1793 for (i = 4; i < *(Int32*)strtab; i++) {
1795 debugBelch("\n"); else
1796 debugBelch("%c", strtab[i] );
1798 debugBelch("--- END of string table---\n");
1803 COFF_symbol* symtab_i;
1804 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1805 symtab_i = (COFF_symbol*)
1806 myindex ( sizeof_COFF_symbol, symtab, i );
1812 printName ( symtab_i->Name, strtab );
1821 (Int32)(symtab_i->SectionNumber),
1822 (UInt32)symtab_i->Type,
1823 (UInt32)symtab_i->StorageClass,
1824 (UInt32)symtab_i->NumberOfAuxSymbols
1826 i += symtab_i->NumberOfAuxSymbols;
1836 ocGetNames_PEi386 ( ObjectCode* oc )
1839 COFF_section* sectab;
1840 COFF_symbol* symtab;
1847 hdr = (COFF_header*)(oc->image);
1848 sectab = (COFF_section*) (
1849 ((UChar*)(oc->image))
1850 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1852 symtab = (COFF_symbol*) (
1853 ((UChar*)(oc->image))
1854 + hdr->PointerToSymbolTable
1856 strtab = ((UChar*)(oc->image))
1857 + hdr->PointerToSymbolTable
1858 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1860 /* Allocate space for any (local, anonymous) .bss sections. */
1862 for (i = 0; i < hdr->NumberOfSections; i++) {
1864 COFF_section* sectab_i
1866 myindex ( sizeof_COFF_section, sectab, i );
1867 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1868 if (sectab_i->VirtualSize == 0) continue;
1869 /* This is a non-empty .bss section. Allocate zeroed space for
1870 it, and set its PointerToRawData field such that oc->image +
1871 PointerToRawData == addr_of_zeroed_space. */
1872 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1873 "ocGetNames_PEi386(anonymous bss)");
1874 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1875 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1876 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
1879 /* Copy section information into the ObjectCode. */
1881 for (i = 0; i < hdr->NumberOfSections; i++) {
1887 = SECTIONKIND_OTHER;
1888 COFF_section* sectab_i
1890 myindex ( sizeof_COFF_section, sectab, i );
1891 IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
1894 /* I'm sure this is the Right Way to do it. However, the
1895 alternative of testing the sectab_i->Name field seems to
1896 work ok with Cygwin.
1898 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1899 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1900 kind = SECTIONKIND_CODE_OR_RODATA;
1903 if (0==strcmp(".text",sectab_i->Name) ||
1904 0==strcmp(".rodata",sectab_i->Name))
1905 kind = SECTIONKIND_CODE_OR_RODATA;
1906 if (0==strcmp(".data",sectab_i->Name) ||
1907 0==strcmp(".bss",sectab_i->Name))
1908 kind = SECTIONKIND_RWDATA;
1910 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1911 sz = sectab_i->SizeOfRawData;
1912 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1914 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1915 end = start + sz - 1;
1917 if (kind == SECTIONKIND_OTHER
1918 /* Ignore sections called which contain stabs debugging
1920 && 0 != strcmp(".stab", sectab_i->Name)
1921 && 0 != strcmp(".stabstr", sectab_i->Name)
1923 errorBelch("Unknown PEi386 section name `%s'", sectab_i->Name);
1927 if (kind != SECTIONKIND_OTHER && end >= start) {
1928 addSection(oc, kind, start, end);
1929 addProddableBlock(oc, start, end - start + 1);
1933 /* Copy exported symbols into the ObjectCode. */
1935 oc->n_symbols = hdr->NumberOfSymbols;
1936 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1937 "ocGetNames_PEi386(oc->symbols)");
1938 /* Call me paranoid; I don't care. */
1939 for (i = 0; i < oc->n_symbols; i++)
1940 oc->symbols[i] = NULL;
1944 COFF_symbol* symtab_i;
1945 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1946 symtab_i = (COFF_symbol*)
1947 myindex ( sizeof_COFF_symbol, symtab, i );
1951 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1952 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1953 /* This symbol is global and defined, viz, exported */
1954 /* for MYIMAGE_SYMCLASS_EXTERNAL
1955 && !MYIMAGE_SYM_UNDEFINED,
1956 the address of the symbol is:
1957 address of relevant section + offset in section
1959 COFF_section* sectabent
1960 = (COFF_section*) myindex ( sizeof_COFF_section,
1962 symtab_i->SectionNumber-1 );
1963 addr = ((UChar*)(oc->image))
1964 + (sectabent->PointerToRawData
1968 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1969 && symtab_i->Value > 0) {
1970 /* This symbol isn't in any section at all, ie, global bss.
1971 Allocate zeroed space for it. */
1972 addr = stgCallocBytes(1, symtab_i->Value,
1973 "ocGetNames_PEi386(non-anonymous bss)");
1974 addSection(oc, SECTIONKIND_RWDATA, addr,
1975 ((UChar*)addr) + symtab_i->Value - 1);
1976 addProddableBlock(oc, addr, symtab_i->Value);
1977 /* debugBelch("BSS section at 0x%x\n", addr); */
1980 if (addr != NULL ) {
1981 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1982 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
1983 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
1984 ASSERT(i >= 0 && i < oc->n_symbols);
1985 /* cstring_from_COFF_symbol_name always succeeds. */
1986 oc->symbols[i] = sname;
1987 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1991 "IGNORING symbol %d\n"
1995 printName ( symtab_i->Name, strtab );
2004 (Int32)(symtab_i->SectionNumber),
2005 (UInt32)symtab_i->Type,
2006 (UInt32)symtab_i->StorageClass,
2007 (UInt32)symtab_i->NumberOfAuxSymbols
2012 i += symtab_i->NumberOfAuxSymbols;
2021 ocResolve_PEi386 ( ObjectCode* oc )
2024 COFF_section* sectab;
2025 COFF_symbol* symtab;
2035 /* ToDo: should be variable-sized? But is at least safe in the
2036 sense of buffer-overrun-proof. */
2038 /* debugBelch("resolving for %s\n", oc->fileName); */
2040 hdr = (COFF_header*)(oc->image);
2041 sectab = (COFF_section*) (
2042 ((UChar*)(oc->image))
2043 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2045 symtab = (COFF_symbol*) (
2046 ((UChar*)(oc->image))
2047 + hdr->PointerToSymbolTable
2049 strtab = ((UChar*)(oc->image))
2050 + hdr->PointerToSymbolTable
2051 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2053 for (i = 0; i < hdr->NumberOfSections; i++) {
2054 COFF_section* sectab_i
2056 myindex ( sizeof_COFF_section, sectab, i );
2059 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2062 /* Ignore sections called which contain stabs debugging
2064 if (0 == strcmp(".stab", sectab_i->Name)
2065 || 0 == strcmp(".stabstr", sectab_i->Name))
2068 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2069 /* If the relocation field (a short) has overflowed, the
2070 * real count can be found in the first reloc entry.
2072 * See Section 4.1 (last para) of the PE spec (rev6.0).
2074 * Nov2003 update: the GNU linker still doesn't correctly
2075 * handle the generation of relocatable object files with
2076 * overflown relocations. Hence the output to warn of potential
2079 COFF_reloc* rel = (COFF_reloc*)
2080 myindex ( sizeof_COFF_reloc, reltab, 0 );
2081 noRelocs = rel->VirtualAddress;
2082 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
2086 noRelocs = sectab_i->NumberOfRelocations;
2091 for (; j < noRelocs; j++) {
2093 COFF_reloc* reltab_j
2095 myindex ( sizeof_COFF_reloc, reltab, j );
2097 /* the location to patch */
2099 ((UChar*)(oc->image))
2100 + (sectab_i->PointerToRawData
2101 + reltab_j->VirtualAddress
2102 - sectab_i->VirtualAddress )
2104 /* the existing contents of pP */
2106 /* the symbol to connect to */
2107 sym = (COFF_symbol*)
2108 myindex ( sizeof_COFF_symbol,
2109 symtab, reltab_j->SymbolTableIndex );
2112 "reloc sec %2d num %3d: type 0x%-4x "
2113 "vaddr 0x%-8x name `",
2115 (UInt32)reltab_j->Type,
2116 reltab_j->VirtualAddress );
2117 printName ( sym->Name, strtab );
2118 debugBelch("'\n" ));
2120 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2121 COFF_section* section_sym
2122 = findPEi386SectionCalled ( oc, sym->Name );
2124 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
2127 S = ((UInt32)(oc->image))
2128 + (section_sym->PointerToRawData
2131 copyName ( sym->Name, strtab, symbol, 1000-1 );
2132 (void*)S = lookupLocalSymbol( oc, symbol );
2133 if ((void*)S != NULL) goto foundit;
2134 (void*)S = lookupSymbol( symbol );
2135 if ((void*)S != NULL) goto foundit;
2136 zapTrailingAtSign ( symbol );
2137 (void*)S = lookupLocalSymbol( oc, symbol );
2138 if ((void*)S != NULL) goto foundit;
2139 (void*)S = lookupSymbol( symbol );
2140 if ((void*)S != NULL) goto foundit;
2141 /* Newline first because the interactive linker has printed "linking..." */
2142 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2146 checkProddableBlock(oc, pP);
2147 switch (reltab_j->Type) {
2148 case MYIMAGE_REL_I386_DIR32:
2151 case MYIMAGE_REL_I386_REL32:
2152 /* Tricky. We have to insert a displacement at
2153 pP which, when added to the PC for the _next_
2154 insn, gives the address of the target (S).
2155 Problem is to know the address of the next insn
2156 when we only know pP. We assume that this
2157 literal field is always the last in the insn,
2158 so that the address of the next insn is pP+4
2159 -- hence the constant 4.
2160 Also I don't know if A should be added, but so
2161 far it has always been zero.
2164 *pP = S - ((UInt32)pP) - 4;
2167 debugBelch("%s: unhandled PEi386 relocation type %d",
2168 oc->fileName, reltab_j->Type);
2175 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
2179 #endif /* defined(OBJFORMAT_PEi386) */
2182 /* --------------------------------------------------------------------------
2184 * ------------------------------------------------------------------------*/
2186 #if defined(OBJFORMAT_ELF)
2191 #if defined(sparc_TARGET_ARCH)
2192 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2193 #elif defined(i386_TARGET_ARCH)
2194 # define ELF_TARGET_386 /* Used inside <elf.h> */
2195 #elif defined(x86_64_TARGET_ARCH)
2196 # define ELF_TARGET_X64_64
2198 #elif defined (ia64_TARGET_ARCH)
2199 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2201 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2202 # define ELF_NEED_GOT /* needs Global Offset Table */
2203 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2206 #if !defined(openbsd_TARGET_OS)
2209 /* openbsd elf has things in different places, with diff names */
2210 #include <elf_abi.h>
2211 #include <machine/reloc.h>
2212 #define R_386_32 RELOC_32
2213 #define R_386_PC32 RELOC_PC32
2217 * Define a set of types which can be used for both ELF32 and ELF64
2221 #define ELFCLASS ELFCLASS64
2222 #define Elf_Addr Elf64_Addr
2223 #define Elf_Word Elf64_Word
2224 #define Elf_Sword Elf64_Sword
2225 #define Elf_Ehdr Elf64_Ehdr
2226 #define Elf_Phdr Elf64_Phdr
2227 #define Elf_Shdr Elf64_Shdr
2228 #define Elf_Sym Elf64_Sym
2229 #define Elf_Rel Elf64_Rel
2230 #define Elf_Rela Elf64_Rela
2231 #define ELF_ST_TYPE ELF64_ST_TYPE
2232 #define ELF_ST_BIND ELF64_ST_BIND
2233 #define ELF_R_TYPE ELF64_R_TYPE
2234 #define ELF_R_SYM ELF64_R_SYM
2236 #define ELFCLASS ELFCLASS32
2237 #define Elf_Addr Elf32_Addr
2238 #define Elf_Word Elf32_Word
2239 #define Elf_Sword Elf32_Sword
2240 #define Elf_Ehdr Elf32_Ehdr
2241 #define Elf_Phdr Elf32_Phdr
2242 #define Elf_Shdr Elf32_Shdr
2243 #define Elf_Sym Elf32_Sym
2244 #define Elf_Rel Elf32_Rel
2245 #define Elf_Rela Elf32_Rela
2247 #define ELF_ST_TYPE ELF32_ST_TYPE
2250 #define ELF_ST_BIND ELF32_ST_BIND
2253 #define ELF_R_TYPE ELF32_R_TYPE
2256 #define ELF_R_SYM ELF32_R_SYM
2262 * Functions to allocate entries in dynamic sections. Currently we simply
2263 * preallocate a large number, and we don't check if a entry for the given
2264 * target already exists (a linear search is too slow). Ideally these
2265 * entries would be associated with symbols.
2268 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2269 #define GOT_SIZE 0x20000
2270 #define FUNCTION_TABLE_SIZE 0x10000
2271 #define PLT_SIZE 0x08000
2274 static Elf_Addr got[GOT_SIZE];
2275 static unsigned int gotIndex;
2276 static Elf_Addr gp_val = (Elf_Addr)got;
2279 allocateGOTEntry(Elf_Addr target)
2283 if (gotIndex >= GOT_SIZE)
2284 barf("Global offset table overflow");
2286 entry = &got[gotIndex++];
2288 return (Elf_Addr)entry;
2292 #ifdef ELF_FUNCTION_DESC
2298 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2299 static unsigned int functionTableIndex;
2302 allocateFunctionDesc(Elf_Addr target)
2304 FunctionDesc *entry;
2306 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2307 barf("Function table overflow");
2309 entry = &functionTable[functionTableIndex++];
2311 entry->gp = (Elf_Addr)gp_val;
2312 return (Elf_Addr)entry;
2316 copyFunctionDesc(Elf_Addr target)
2318 FunctionDesc *olddesc = (FunctionDesc *)target;
2319 FunctionDesc *newdesc;
2321 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2322 newdesc->gp = olddesc->gp;
2323 return (Elf_Addr)newdesc;
2328 #ifdef ia64_TARGET_ARCH
2329 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2330 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2332 static unsigned char plt_code[] =
2334 /* taken from binutils bfd/elfxx-ia64.c */
2335 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2336 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2337 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2338 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2339 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2340 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2343 /* If we can't get to the function descriptor via gp, take a local copy of it */
2344 #define PLT_RELOC(code, target) { \
2345 Elf64_Sxword rel_value = target - gp_val; \
2346 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2347 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2349 ia64_reloc_gprel22((Elf_Addr)code, target); \
2354 unsigned char code[sizeof(plt_code)];
2358 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2360 PLTEntry *plt = (PLTEntry *)oc->plt;
2363 if (oc->pltIndex >= PLT_SIZE)
2364 barf("Procedure table overflow");
2366 entry = &plt[oc->pltIndex++];
2367 memcpy(entry->code, plt_code, sizeof(entry->code));
2368 PLT_RELOC(entry->code, target);
2369 return (Elf_Addr)entry;
2375 return (PLT_SIZE * sizeof(PLTEntry));
2381 * Generic ELF functions
2385 findElfSection ( void* objImage, Elf_Word sh_type )
2387 char* ehdrC = (char*)objImage;
2388 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2389 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2390 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2394 for (i = 0; i < ehdr->e_shnum; i++) {
2395 if (shdr[i].sh_type == sh_type
2396 /* Ignore the section header's string table. */
2397 && i != ehdr->e_shstrndx
2398 /* Ignore string tables named .stabstr, as they contain
2400 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2402 ptr = ehdrC + shdr[i].sh_offset;
2409 #if defined(ia64_TARGET_ARCH)
2411 findElfSegment ( void* objImage, Elf_Addr vaddr )
2413 char* ehdrC = (char*)objImage;
2414 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2415 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2416 Elf_Addr segaddr = 0;
2419 for (i = 0; i < ehdr->e_phnum; i++) {
2420 segaddr = phdr[i].p_vaddr;
2421 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2429 ocVerifyImage_ELF ( ObjectCode* oc )
2433 int i, j, nent, nstrtab, nsymtabs;
2437 char* ehdrC = (char*)(oc->image);
2438 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2440 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2441 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2442 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2443 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2444 errorBelch("%s: not an ELF object", oc->fileName);
2448 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2449 errorBelch("%s: unsupported ELF format", oc->fileName);
2453 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2454 IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
2456 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2457 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
2459 errorBelch("%s: unknown endiannness", oc->fileName);
2463 if (ehdr->e_type != ET_REL) {
2464 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
2467 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
2469 IF_DEBUG(linker,debugBelch( "Architecture is " ));
2470 switch (ehdr->e_machine) {
2471 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
2472 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
2474 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
2476 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
2477 default: IF_DEBUG(linker,debugBelch( "unknown" ));
2478 errorBelch("%s: unknown architecture", oc->fileName);
2482 IF_DEBUG(linker,debugBelch(
2483 "\nSection header table: start %d, n_entries %d, ent_size %d\n",
2484 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2486 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2488 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2490 if (ehdr->e_shstrndx == SHN_UNDEF) {
2491 errorBelch("%s: no section header string table", oc->fileName);
2494 IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
2496 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2499 for (i = 0; i < ehdr->e_shnum; i++) {
2500 IF_DEBUG(linker,debugBelch("%2d: ", i ));
2501 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
2502 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
2503 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
2504 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
2505 ehdrC + shdr[i].sh_offset,
2506 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2508 if (shdr[i].sh_type == SHT_REL) {
2509 IF_DEBUG(linker,debugBelch("Rel " ));
2510 } else if (shdr[i].sh_type == SHT_RELA) {
2511 IF_DEBUG(linker,debugBelch("RelA " ));
2513 IF_DEBUG(linker,debugBelch(" "));
2516 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
2520 IF_DEBUG(linker,debugBelch( "\nString tables" ));
2523 for (i = 0; i < ehdr->e_shnum; i++) {
2524 if (shdr[i].sh_type == SHT_STRTAB
2525 /* Ignore the section header's string table. */
2526 && i != ehdr->e_shstrndx
2527 /* Ignore string tables named .stabstr, as they contain
2529 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2531 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
2532 strtab = ehdrC + shdr[i].sh_offset;
2537 errorBelch("%s: no string tables, or too many", oc->fileName);
2542 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
2543 for (i = 0; i < ehdr->e_shnum; i++) {
2544 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2545 IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
2547 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2548 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2549 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%d rem)\n",
2551 shdr[i].sh_size % sizeof(Elf_Sym)
2553 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2554 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
2557 for (j = 0; j < nent; j++) {
2558 IF_DEBUG(linker,debugBelch(" %2d ", j ));
2559 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
2560 (int)stab[j].st_shndx,
2561 (int)stab[j].st_size,
2562 (char*)stab[j].st_value ));
2564 IF_DEBUG(linker,debugBelch("type=" ));
2565 switch (ELF_ST_TYPE(stab[j].st_info)) {
2566 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
2567 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
2568 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
2569 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
2570 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
2571 default: IF_DEBUG(linker,debugBelch("? " )); break;
2573 IF_DEBUG(linker,debugBelch(" " ));
2575 IF_DEBUG(linker,debugBelch("bind=" ));
2576 switch (ELF_ST_BIND(stab[j].st_info)) {
2577 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
2578 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
2579 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
2580 default: IF_DEBUG(linker,debugBelch("? " )); break;
2582 IF_DEBUG(linker,debugBelch(" " ));
2584 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
2588 if (nsymtabs == 0) {
2589 errorBelch("%s: didn't find any symbol tables", oc->fileName);
2596 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
2600 if (hdr->sh_type == SHT_PROGBITS
2601 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
2602 /* .text-style section */
2603 return SECTIONKIND_CODE_OR_RODATA;
2606 if (hdr->sh_type == SHT_PROGBITS
2607 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2608 /* .data-style section */
2609 return SECTIONKIND_RWDATA;
2612 if (hdr->sh_type == SHT_PROGBITS
2613 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
2614 /* .rodata-style section */
2615 return SECTIONKIND_CODE_OR_RODATA;
2618 if (hdr->sh_type == SHT_NOBITS
2619 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2620 /* .bss-style section */
2622 return SECTIONKIND_RWDATA;
2625 return SECTIONKIND_OTHER;
2630 ocGetNames_ELF ( ObjectCode* oc )
2635 char* ehdrC = (char*)(oc->image);
2636 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2637 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2638 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2640 ASSERT(symhash != NULL);
2643 errorBelch("%s: no strtab", oc->fileName);
2648 for (i = 0; i < ehdr->e_shnum; i++) {
2649 /* Figure out what kind of section it is. Logic derived from
2650 Figure 1.14 ("Special Sections") of the ELF document
2651 ("Portable Formats Specification, Version 1.1"). */
2653 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
2655 if (is_bss && shdr[i].sh_size > 0) {
2656 /* This is a non-empty .bss section. Allocate zeroed space for
2657 it, and set its .sh_offset field such that
2658 ehdrC + .sh_offset == addr_of_zeroed_space. */
2659 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2660 "ocGetNames_ELF(BSS)");
2661 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2663 debugBelch("BSS section at 0x%x, size %d\n",
2664 zspace, shdr[i].sh_size);
2668 /* fill in the section info */
2669 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2670 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2671 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2672 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2675 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2677 /* copy stuff into this module's object symbol table */
2678 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2679 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2681 oc->n_symbols = nent;
2682 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2683 "ocGetNames_ELF(oc->symbols)");
2685 for (j = 0; j < nent; j++) {
2687 char isLocal = FALSE; /* avoids uninit-var warning */
2689 char* nm = strtab + stab[j].st_name;
2690 int secno = stab[j].st_shndx;
2692 /* Figure out if we want to add it; if so, set ad to its
2693 address. Otherwise leave ad == NULL. */
2695 if (secno == SHN_COMMON) {
2697 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2699 debugBelch("COMMON symbol, size %d name %s\n",
2700 stab[j].st_size, nm);
2702 /* Pointless to do addProddableBlock() for this area,
2703 since the linker should never poke around in it. */
2706 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2707 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2709 /* and not an undefined symbol */
2710 && stab[j].st_shndx != SHN_UNDEF
2711 /* and not in a "special section" */
2712 && stab[j].st_shndx < SHN_LORESERVE
2714 /* and it's a not a section or string table or anything silly */
2715 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2716 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2717 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2720 /* Section 0 is the undefined section, hence > and not >=. */
2721 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2723 if (shdr[secno].sh_type == SHT_NOBITS) {
2724 debugBelch(" BSS symbol, size %d off %d name %s\n",
2725 stab[j].st_size, stab[j].st_value, nm);
2728 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2729 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2732 #ifdef ELF_FUNCTION_DESC
2733 /* dlsym() and the initialisation table both give us function
2734 * descriptors, so to be consistent we store function descriptors
2735 * in the symbol table */
2736 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2737 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2739 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s",
2740 ad, oc->fileName, nm ));
2745 /* And the decision is ... */
2749 oc->symbols[j] = nm;
2752 /* Ignore entirely. */
2754 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2758 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
2759 strtab + stab[j].st_name ));
2762 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2763 (int)ELF_ST_BIND(stab[j].st_info),
2764 (int)ELF_ST_TYPE(stab[j].st_info),
2765 (int)stab[j].st_shndx,
2766 strtab + stab[j].st_name
2769 oc->symbols[j] = NULL;
2778 /* Do ELF relocations which lack an explicit addend. All x86-linux
2779 relocations appear to be of this form. */
2781 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2782 Elf_Shdr* shdr, int shnum,
2783 Elf_Sym* stab, char* strtab )
2788 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2789 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2790 int target_shndx = shdr[shnum].sh_info;
2791 int symtab_shndx = shdr[shnum].sh_link;
2793 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2794 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2795 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
2796 target_shndx, symtab_shndx ));
2798 /* Skip sections that we're not interested in. */
2801 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
2802 if (kind == SECTIONKIND_OTHER) {
2803 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
2808 for (j = 0; j < nent; j++) {
2809 Elf_Addr offset = rtab[j].r_offset;
2810 Elf_Addr info = rtab[j].r_info;
2812 Elf_Addr P = ((Elf_Addr)targ) + offset;
2813 Elf_Word* pP = (Elf_Word*)P;
2819 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
2820 j, (void*)offset, (void*)info ));
2822 IF_DEBUG(linker,debugBelch( " ZERO" ));
2825 Elf_Sym sym = stab[ELF_R_SYM(info)];
2826 /* First see if it is a local symbol. */
2827 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2828 /* Yes, so we can get the address directly from the ELF symbol
2830 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2832 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2833 + stab[ELF_R_SYM(info)].st_value);
2836 /* No, so look up the name in our global table. */
2837 symbol = strtab + sym.st_name;
2838 S_tmp = lookupSymbol( symbol );
2839 S = (Elf_Addr)S_tmp;
2842 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
2845 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
2848 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
2849 (void*)P, (void*)S, (void*)A ));
2850 checkProddableBlock ( oc, pP );
2854 switch (ELF_R_TYPE(info)) {
2855 # ifdef i386_TARGET_ARCH
2856 case R_386_32: *pP = value; break;
2857 case R_386_PC32: *pP = value - P; break;
2860 errorBelch("%s: unhandled ELF relocation(Rel) type %d\n",
2861 oc->fileName, ELF_R_TYPE(info));
2869 /* Do ELF relocations for which explicit addends are supplied.
2870 sparc-solaris relocations appear to be of this form. */
2872 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2873 Elf_Shdr* shdr, int shnum,
2874 Elf_Sym* stab, char* strtab )
2879 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2880 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2881 int target_shndx = shdr[shnum].sh_info;
2882 int symtab_shndx = shdr[shnum].sh_link;
2884 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2885 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2886 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
2887 target_shndx, symtab_shndx ));
2889 for (j = 0; j < nent; j++) {
2890 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH) || defined(powerpc_TARGET_ARCH)
2891 /* This #ifdef only serves to avoid unused-var warnings. */
2892 Elf_Addr offset = rtab[j].r_offset;
2893 Elf_Addr P = targ + offset;
2895 Elf_Addr info = rtab[j].r_info;
2896 Elf_Addr A = rtab[j].r_addend;
2900 # if defined(sparc_TARGET_ARCH)
2901 Elf_Word* pP = (Elf_Word*)P;
2903 # elif defined(ia64_TARGET_ARCH)
2904 Elf64_Xword *pP = (Elf64_Xword *)P;
2906 # elif defined(powerpc_TARGET_ARCH)
2910 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
2911 j, (void*)offset, (void*)info,
2914 IF_DEBUG(linker,debugBelch( " ZERO" ));
2917 Elf_Sym sym = stab[ELF_R_SYM(info)];
2918 /* First see if it is a local symbol. */
2919 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2920 /* Yes, so we can get the address directly from the ELF symbol
2922 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2924 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2925 + stab[ELF_R_SYM(info)].st_value);
2926 #ifdef ELF_FUNCTION_DESC
2927 /* Make a function descriptor for this function */
2928 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2929 S = allocateFunctionDesc(S + A);
2934 /* No, so look up the name in our global table. */
2935 symbol = strtab + sym.st_name;
2936 S_tmp = lookupSymbol( symbol );
2937 S = (Elf_Addr)S_tmp;
2939 #ifdef ELF_FUNCTION_DESC
2940 /* If a function, already a function descriptor - we would
2941 have to copy it to add an offset. */
2942 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2943 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2947 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
2950 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
2953 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
2954 (void*)P, (void*)S, (void*)A ));
2955 /* checkProddableBlock ( oc, (void*)P ); */
2959 switch (ELF_R_TYPE(info)) {
2960 # if defined(sparc_TARGET_ARCH)
2961 case R_SPARC_WDISP30:
2962 w1 = *pP & 0xC0000000;
2963 w2 = (Elf_Word)((value - P) >> 2);
2964 ASSERT((w2 & 0xC0000000) == 0);
2969 w1 = *pP & 0xFFC00000;
2970 w2 = (Elf_Word)(value >> 10);
2971 ASSERT((w2 & 0xFFC00000) == 0);
2977 w2 = (Elf_Word)(value & 0x3FF);
2978 ASSERT((w2 & ~0x3FF) == 0);
2982 /* According to the Sun documentation:
2984 This relocation type resembles R_SPARC_32, except it refers to an
2985 unaligned word. That is, the word to be relocated must be treated
2986 as four separate bytes with arbitrary alignment, not as a word
2987 aligned according to the architecture requirements.
2989 (JRS: which means that freeloading on the R_SPARC_32 case
2990 is probably wrong, but hey ...)
2994 w2 = (Elf_Word)value;
2997 # elif defined(ia64_TARGET_ARCH)
2998 case R_IA64_DIR64LSB:
2999 case R_IA64_FPTR64LSB:
3002 case R_IA64_PCREL64LSB:
3005 case R_IA64_SEGREL64LSB:
3006 addr = findElfSegment(ehdrC, value);
3009 case R_IA64_GPREL22:
3010 ia64_reloc_gprel22(P, value);
3012 case R_IA64_LTOFF22:
3013 case R_IA64_LTOFF22X:
3014 case R_IA64_LTOFF_FPTR22:
3015 addr = allocateGOTEntry(value);
3016 ia64_reloc_gprel22(P, addr);
3018 case R_IA64_PCREL21B:
3019 ia64_reloc_pcrel21(P, S, oc);
3022 /* This goes with R_IA64_LTOFF22X and points to the load to
3023 * convert into a move. We don't implement relaxation. */
3025 # elif defined(powerpc_TARGET_ARCH)
3026 case R_PPC_ADDR16_LO:
3027 *(Elf32_Half*) P = value;
3030 case R_PPC_ADDR16_HI:
3031 *(Elf32_Half*) P = value >> 16;
3034 case R_PPC_ADDR16_HA:
3035 *(Elf32_Half*) P = (value + 0x8000) >> 16;
3039 *(Elf32_Word *) P = value;
3043 *(Elf32_Word *) P = value - P;
3049 if( delta << 6 >> 6 != delta )
3051 value = makeJumpIsland( oc, ELF_R_SYM(info), value );
3054 if( value == 0 || delta << 6 >> 6 != delta )
3056 barf( "Unable to make ppcJumpIsland for #%d",
3062 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3063 | (delta & 0x3fffffc);
3067 errorBelch("%s: unhandled ELF relocation(RelA) type %d\n",
3068 oc->fileName, ELF_R_TYPE(info));
3077 ocResolve_ELF ( ObjectCode* oc )
3081 Elf_Sym* stab = NULL;
3082 char* ehdrC = (char*)(oc->image);
3083 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
3084 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3086 /* first find "the" symbol table */
3087 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
3089 /* also go find the string table */
3090 strtab = findElfSection ( ehdrC, SHT_STRTAB );
3092 if (stab == NULL || strtab == NULL) {
3093 errorBelch("%s: can't find string or symbol table", oc->fileName);
3097 /* Process the relocation sections. */
3098 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
3099 if (shdr[shnum].sh_type == SHT_REL) {
3100 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
3101 shnum, stab, strtab );
3105 if (shdr[shnum].sh_type == SHT_RELA) {
3106 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
3107 shnum, stab, strtab );
3112 /* Free the local symbol table; we won't need it again. */
3113 freeHashTable(oc->lochash, NULL);
3116 #if defined(powerpc_TARGET_ARCH)
3117 ocFlushInstructionCache( oc );
3125 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
3126 * at the front. The following utility functions pack and unpack instructions, and
3127 * take care of the most common relocations.
3130 #ifdef ia64_TARGET_ARCH
3133 ia64_extract_instruction(Elf64_Xword *target)
3136 int slot = (Elf_Addr)target & 3;
3137 (Elf_Addr)target &= ~3;
3145 return ((w1 >> 5) & 0x1ffffffffff);
3147 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
3151 barf("ia64_extract_instruction: invalid slot %p", target);
3156 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
3158 int slot = (Elf_Addr)target & 3;
3159 (Elf_Addr)target &= ~3;
3164 *target |= value << 5;
3167 *target |= value << 46;
3168 *(target+1) |= value >> 18;
3171 *(target+1) |= value << 23;
3177 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3179 Elf64_Xword instruction;
3180 Elf64_Sxword rel_value;
3182 rel_value = value - gp_val;
3183 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3184 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3186 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3187 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3188 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3189 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3190 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3191 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3195 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3197 Elf64_Xword instruction;
3198 Elf64_Sxword rel_value;
3201 entry = allocatePLTEntry(value, oc);
3203 rel_value = (entry >> 4) - (target >> 4);
3204 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3205 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3207 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3208 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3209 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3210 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3216 * PowerPC ELF specifics
3219 #ifdef powerpc_TARGET_ARCH
3221 static int ocAllocateJumpIslands_ELF( ObjectCode *oc )
3227 ehdr = (Elf_Ehdr *) oc->image;
3228 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
3230 for( i = 0; i < ehdr->e_shnum; i++ )
3231 if( shdr[i].sh_type == SHT_SYMTAB )
3234 if( i == ehdr->e_shnum )
3236 errorBelch( "This ELF file contains no symtab" );
3240 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
3242 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
3243 shdr[i].sh_entsize, sizeof( Elf_Sym ) );
3248 return ocAllocateJumpIslands( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
3251 #endif /* powerpc */
3255 /* --------------------------------------------------------------------------
3257 * ------------------------------------------------------------------------*/
3259 #if defined(OBJFORMAT_MACHO)
3262 Support for MachO linking on Darwin/MacOS X on PowerPC chips
3263 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3265 I hereby formally apologize for the hackish nature of this code.
3266 Things that need to be done:
3267 *) implement ocVerifyImage_MachO
3268 *) add still more sanity checks.
3271 static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
3273 struct mach_header *header = (struct mach_header *) oc->image;
3274 struct load_command *lc = (struct load_command *) (header + 1);
3277 for( i = 0; i < header->ncmds; i++ )
3279 if( lc->cmd == LC_SYMTAB )
3281 // Find out the first and last undefined external
3282 // symbol, so we don't have to allocate too many
3284 struct symtab_command *symLC = (struct symtab_command *) lc;
3285 int min = symLC->nsyms, max = 0;
3286 struct nlist *nlist =
3287 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
3289 for(i=0;i<symLC->nsyms;i++)
3291 if(nlist[i].n_type & N_STAB)
3293 else if(nlist[i].n_type & N_EXT)
3295 if((nlist[i].n_type & N_TYPE) == N_UNDF
3296 && (nlist[i].n_value == 0))
3306 return ocAllocateJumpIslands(oc, max - min + 1, min);
3311 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3313 return ocAllocateJumpIslands(oc,0,0);
3316 static int ocVerifyImage_MachO(ObjectCode* oc)
3318 // FIXME: do some verifying here
3322 static int resolveImports(
3325 struct symtab_command *symLC,
3326 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3327 unsigned long *indirectSyms,
3328 struct nlist *nlist)
3332 for(i=0;i*4<sect->size;i++)
3334 // according to otool, reserved1 contains the first index into the indirect symbol table
3335 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3336 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3339 if((symbol->n_type & N_TYPE) == N_UNDF
3340 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3341 addr = (void*) (symbol->n_value);
3342 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3345 addr = lookupSymbol(nm);
3348 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3352 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3353 ((void**)(image + sect->offset))[i] = addr;
3359 static char* relocateAddress(
3362 struct section* sections,
3363 unsigned long address)
3366 for(i = 0; i < nSections; i++)
3368 if(sections[i].addr <= address
3369 && address < sections[i].addr + sections[i].size)
3371 return oc->image + sections[i].offset + address - sections[i].addr;
3374 barf("Invalid Mach-O file:"
3375 "Address out of bounds while relocating object file");
3379 static int relocateSection(
3382 struct symtab_command *symLC, struct nlist *nlist,
3383 int nSections, struct section* sections, struct section *sect)
3385 struct relocation_info *relocs;
3388 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3390 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3394 relocs = (struct relocation_info*) (image + sect->reloff);
3398 if(relocs[i].r_address & R_SCATTERED)
3400 struct scattered_relocation_info *scat =
3401 (struct scattered_relocation_info*) &relocs[i];
3405 if(scat->r_length == 2)
3407 unsigned long word = 0;
3408 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
3409 checkProddableBlock(oc,wordPtr);
3411 // Step 1: Figure out what the relocated value should be
3412 if(scat->r_type == GENERIC_RELOC_VANILLA)
3414 word = *wordPtr + (unsigned long) relocateAddress(
3421 else if(scat->r_type == PPC_RELOC_SECTDIFF
3422 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
3423 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
3424 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3426 struct scattered_relocation_info *pair =
3427 (struct scattered_relocation_info*) &relocs[i+1];
3429 if(!pair->r_scattered || pair->r_type != PPC_RELOC_PAIR)
3430 barf("Invalid Mach-O file: "
3431 "PPC_RELOC_*_SECTDIFF not followed by PPC_RELOC_PAIR");
3433 word = (unsigned long)
3434 (relocateAddress(oc, nSections, sections, scat->r_value)
3435 - relocateAddress(oc, nSections, sections, pair->r_value));
3438 else if(scat->r_type == PPC_RELOC_HI16
3439 || scat->r_type == PPC_RELOC_LO16
3440 || scat->r_type == PPC_RELOC_HA16
3441 || scat->r_type == PPC_RELOC_LO14)
3442 { // these are generated by label+offset things
3443 struct relocation_info *pair = &relocs[i+1];
3444 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
3445 barf("Invalid Mach-O file: "
3446 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
3448 if(scat->r_type == PPC_RELOC_LO16)
3450 word = ((unsigned short*) wordPtr)[1];
3451 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3453 else if(scat->r_type == PPC_RELOC_LO14)
3455 barf("Unsupported Relocation: PPC_RELOC_LO14");
3456 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
3457 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3459 else if(scat->r_type == PPC_RELOC_HI16)
3461 word = ((unsigned short*) wordPtr)[1] << 16;
3462 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3464 else if(scat->r_type == PPC_RELOC_HA16)
3466 word = ((unsigned short*) wordPtr)[1] << 16;
3467 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3471 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
3477 continue; // ignore the others
3479 if(scat->r_type == GENERIC_RELOC_VANILLA
3480 || scat->r_type == PPC_RELOC_SECTDIFF)
3484 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
3486 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3488 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
3490 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3492 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
3494 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3495 + ((word & (1<<15)) ? 1 : 0);
3500 continue; // FIXME: I hope it's OK to ignore all the others.
3504 struct relocation_info *reloc = &relocs[i];
3505 if(reloc->r_pcrel && !reloc->r_extern)
3508 if(reloc->r_length == 2)
3510 unsigned long word = 0;
3511 unsigned long jumpIsland = 0;
3512 long offsetToJumpIsland;
3514 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3515 checkProddableBlock(oc,wordPtr);
3517 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3521 else if(reloc->r_type == PPC_RELOC_LO16)
3523 word = ((unsigned short*) wordPtr)[1];
3524 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3526 else if(reloc->r_type == PPC_RELOC_HI16)
3528 word = ((unsigned short*) wordPtr)[1] << 16;
3529 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3531 else if(reloc->r_type == PPC_RELOC_HA16)
3533 word = ((unsigned short*) wordPtr)[1] << 16;
3534 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3536 else if(reloc->r_type == PPC_RELOC_BR24)
3539 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
3543 if(!reloc->r_extern)
3546 sections[reloc->r_symbolnum-1].offset
3547 - sections[reloc->r_symbolnum-1].addr
3554 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3555 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3556 unsigned long symbolAddress = (unsigned long) (lookupSymbol(nm));
3559 errorBelch("\nunknown symbol `%s'", nm);
3565 // In the .o file, this should be a relative jump to NULL
3566 // and we'll change it to a jump to a relative jump to the symbol
3567 ASSERT(-word == reloc->r_address);
3568 word = symbolAddress;
3569 jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,word);
3570 word -= ((long)image) + sect->offset + reloc->r_address;
3573 offsetToJumpIsland = jumpIsland
3574 - (((long)image) + sect->offset + reloc->r_address);
3579 word += symbolAddress;
3583 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3588 else if(reloc->r_type == PPC_RELOC_LO16)
3590 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3593 else if(reloc->r_type == PPC_RELOC_HI16)
3595 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3598 else if(reloc->r_type == PPC_RELOC_HA16)
3600 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3601 + ((word & (1<<15)) ? 1 : 0);
3604 else if(reloc->r_type == PPC_RELOC_BR24)
3606 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3608 // The branch offset is too large.
3609 // Therefore, we try to use a jump island.
3612 barf("unconditional relative branch out of range: "
3613 "no jump island available");
3616 word = offsetToJumpIsland;
3617 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3618 barf("unconditional relative branch out of range: "
3619 "jump island out of range");
3621 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3625 barf("\nunknown relocation %d",reloc->r_type);
3632 static int ocGetNames_MachO(ObjectCode* oc)
3634 char *image = (char*) oc->image;
3635 struct mach_header *header = (struct mach_header*) image;
3636 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3637 unsigned i,curSymbol;
3638 struct segment_command *segLC = NULL;
3639 struct section *sections;
3640 struct symtab_command *symLC = NULL;
3641 struct nlist *nlist;
3642 unsigned long commonSize = 0;
3643 char *commonStorage = NULL;
3644 unsigned long commonCounter;
3646 for(i=0;i<header->ncmds;i++)
3648 if(lc->cmd == LC_SEGMENT)
3649 segLC = (struct segment_command*) lc;
3650 else if(lc->cmd == LC_SYMTAB)
3651 symLC = (struct symtab_command*) lc;
3652 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3655 sections = (struct section*) (segLC+1);
3656 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
3659 for(i=0;i<segLC->nsects;i++)
3661 if(sections[i].size == 0)
3664 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
3666 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
3667 "ocGetNames_MachO(common symbols)");
3668 sections[i].offset = zeroFillArea - image;
3671 if(!strcmp(sections[i].sectname,"__text"))
3672 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3673 (void*) (image + sections[i].offset),
3674 (void*) (image + sections[i].offset + sections[i].size));
3675 else if(!strcmp(sections[i].sectname,"__const"))
3676 addSection(oc, SECTIONKIND_RWDATA,
3677 (void*) (image + sections[i].offset),
3678 (void*) (image + sections[i].offset + sections[i].size));
3679 else if(!strcmp(sections[i].sectname,"__data"))
3680 addSection(oc, SECTIONKIND_RWDATA,
3681 (void*) (image + sections[i].offset),
3682 (void*) (image + sections[i].offset + sections[i].size));
3683 else if(!strcmp(sections[i].sectname,"__bss")
3684 || !strcmp(sections[i].sectname,"__common"))
3685 addSection(oc, SECTIONKIND_RWDATA,
3686 (void*) (image + sections[i].offset),
3687 (void*) (image + sections[i].offset + sections[i].size));
3689 addProddableBlock(oc, (void*) (image + sections[i].offset),
3693 // count external symbols defined here
3697 for(i=0;i<symLC->nsyms;i++)
3699 if(nlist[i].n_type & N_STAB)
3701 else if(nlist[i].n_type & N_EXT)
3703 if((nlist[i].n_type & N_TYPE) == N_UNDF
3704 && (nlist[i].n_value != 0))
3706 commonSize += nlist[i].n_value;
3709 else if((nlist[i].n_type & N_TYPE) == N_SECT)
3714 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3715 "ocGetNames_MachO(oc->symbols)");
3720 for(i=0;i<symLC->nsyms;i++)
3722 if(nlist[i].n_type & N_STAB)
3724 else if((nlist[i].n_type & N_TYPE) == N_SECT)
3726 if(nlist[i].n_type & N_EXT)
3728 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3729 ghciInsertStrHashTable(oc->fileName, symhash, nm,
3731 + sections[nlist[i].n_sect-1].offset
3732 - sections[nlist[i].n_sect-1].addr
3733 + nlist[i].n_value);
3734 oc->symbols[curSymbol++] = nm;
3738 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3739 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm,
3741 + sections[nlist[i].n_sect-1].offset
3742 - sections[nlist[i].n_sect-1].addr
3743 + nlist[i].n_value);
3749 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3750 commonCounter = (unsigned long)commonStorage;
3753 for(i=0;i<symLC->nsyms;i++)
3755 if((nlist[i].n_type & N_TYPE) == N_UNDF
3756 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3758 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3759 unsigned long sz = nlist[i].n_value;
3761 nlist[i].n_value = commonCounter;
3763 ghciInsertStrHashTable(oc->fileName, symhash, nm,
3764 (void*)commonCounter);
3765 oc->symbols[curSymbol++] = nm;
3767 commonCounter += sz;
3774 static int ocResolve_MachO(ObjectCode* oc)
3776 char *image = (char*) oc->image;
3777 struct mach_header *header = (struct mach_header*) image;
3778 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3780 struct segment_command *segLC = NULL;
3781 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3782 struct symtab_command *symLC = NULL;
3783 struct dysymtab_command *dsymLC = NULL;
3784 struct nlist *nlist;
3786 for(i=0;i<header->ncmds;i++)
3788 if(lc->cmd == LC_SEGMENT)
3789 segLC = (struct segment_command*) lc;
3790 else if(lc->cmd == LC_SYMTAB)
3791 symLC = (struct symtab_command*) lc;
3792 else if(lc->cmd == LC_DYSYMTAB)
3793 dsymLC = (struct dysymtab_command*) lc;
3794 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3797 sections = (struct section*) (segLC+1);
3798 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
3801 for(i=0;i<segLC->nsects;i++)
3803 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3804 la_ptrs = §ions[i];
3805 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3806 nl_ptrs = §ions[i];
3811 unsigned long *indirectSyms
3812 = (unsigned long*) (image + dsymLC->indirectsymoff);
3815 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3818 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3822 for(i=0;i<segLC->nsects;i++)
3824 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
3828 /* Free the local symbol table; we won't need it again. */
3829 freeHashTable(oc->lochash, NULL);
3832 #if defined (powerpc_TARGET_ARCH)
3833 ocFlushInstructionCache( oc );
3840 * The Mach-O object format uses leading underscores. But not everywhere.
3841 * There is a small number of runtime support functions defined in
3842 * libcc_dynamic.a whose name does not have a leading underscore.
3843 * As a consequence, we can't get their address from C code.
3844 * We have to use inline assembler just to take the address of a function.
3848 static void machoInitSymbolsWithoutUnderscore()
3850 extern void* symbolsWithoutUnderscore[];
3851 void **p = symbolsWithoutUnderscore;
3852 __asm__ volatile(".data\n_symbolsWithoutUnderscore:");
3856 __asm__ volatile(".long " # x);
3858 RTS_MACHO_NOUNDERLINE_SYMBOLS
3860 __asm__ volatile(".text");
3864 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
3866 RTS_MACHO_NOUNDERLINE_SYMBOLS