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\n" ));
2455 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2456 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
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\n" ));
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\n",
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\n",
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\n", 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)\n",
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);
2595 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
2599 if (hdr->sh_type == SHT_PROGBITS
2600 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
2601 /* .text-style section */
2602 return SECTIONKIND_CODE_OR_RODATA;
2605 if (hdr->sh_type == SHT_PROGBITS
2606 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2607 /* .data-style section */
2608 return SECTIONKIND_RWDATA;
2611 if (hdr->sh_type == SHT_PROGBITS
2612 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
2613 /* .rodata-style section */
2614 return SECTIONKIND_CODE_OR_RODATA;
2617 if (hdr->sh_type == SHT_NOBITS
2618 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2619 /* .bss-style section */
2621 return SECTIONKIND_RWDATA;
2624 return SECTIONKIND_OTHER;
2629 ocGetNames_ELF ( ObjectCode* oc )
2634 char* ehdrC = (char*)(oc->image);
2635 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2636 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2637 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2639 ASSERT(symhash != NULL);
2642 errorBelch("%s: no strtab", oc->fileName);
2647 for (i = 0; i < ehdr->e_shnum; i++) {
2648 /* Figure out what kind of section it is. Logic derived from
2649 Figure 1.14 ("Special Sections") of the ELF document
2650 ("Portable Formats Specification, Version 1.1"). */
2652 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
2654 if (is_bss && shdr[i].sh_size > 0) {
2655 /* This is a non-empty .bss section. Allocate zeroed space for
2656 it, and set its .sh_offset field such that
2657 ehdrC + .sh_offset == addr_of_zeroed_space. */
2658 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2659 "ocGetNames_ELF(BSS)");
2660 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2662 debugBelch("BSS section at 0x%x, size %d\n",
2663 zspace, shdr[i].sh_size);
2667 /* fill in the section info */
2668 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2669 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2670 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2671 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2674 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2676 /* copy stuff into this module's object symbol table */
2677 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2678 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2680 oc->n_symbols = nent;
2681 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2682 "ocGetNames_ELF(oc->symbols)");
2684 for (j = 0; j < nent; j++) {
2686 char isLocal = FALSE; /* avoids uninit-var warning */
2688 char* nm = strtab + stab[j].st_name;
2689 int secno = stab[j].st_shndx;
2691 /* Figure out if we want to add it; if so, set ad to its
2692 address. Otherwise leave ad == NULL. */
2694 if (secno == SHN_COMMON) {
2696 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2698 debugBelch("COMMON symbol, size %d name %s\n",
2699 stab[j].st_size, nm);
2701 /* Pointless to do addProddableBlock() for this area,
2702 since the linker should never poke around in it. */
2705 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2706 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2708 /* and not an undefined symbol */
2709 && stab[j].st_shndx != SHN_UNDEF
2710 /* and not in a "special section" */
2711 && stab[j].st_shndx < SHN_LORESERVE
2713 /* and it's a not a section or string table or anything silly */
2714 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2715 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2716 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2719 /* Section 0 is the undefined section, hence > and not >=. */
2720 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2722 if (shdr[secno].sh_type == SHT_NOBITS) {
2723 debugBelch(" BSS symbol, size %d off %d name %s\n",
2724 stab[j].st_size, stab[j].st_value, nm);
2727 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2728 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2731 #ifdef ELF_FUNCTION_DESC
2732 /* dlsym() and the initialisation table both give us function
2733 * descriptors, so to be consistent we store function descriptors
2734 * in the symbol table */
2735 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2736 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2738 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s",
2739 ad, oc->fileName, nm ));
2744 /* And the decision is ... */
2748 oc->symbols[j] = nm;
2751 /* Ignore entirely. */
2753 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2757 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
2758 strtab + stab[j].st_name ));
2761 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2762 (int)ELF_ST_BIND(stab[j].st_info),
2763 (int)ELF_ST_TYPE(stab[j].st_info),
2764 (int)stab[j].st_shndx,
2765 strtab + stab[j].st_name
2768 oc->symbols[j] = NULL;
2777 /* Do ELF relocations which lack an explicit addend. All x86-linux
2778 relocations appear to be of this form. */
2780 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2781 Elf_Shdr* shdr, int shnum,
2782 Elf_Sym* stab, char* strtab )
2787 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2788 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2789 int target_shndx = shdr[shnum].sh_info;
2790 int symtab_shndx = shdr[shnum].sh_link;
2792 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2793 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2794 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
2795 target_shndx, symtab_shndx ));
2797 /* Skip sections that we're not interested in. */
2800 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
2801 if (kind == SECTIONKIND_OTHER) {
2802 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
2807 for (j = 0; j < nent; j++) {
2808 Elf_Addr offset = rtab[j].r_offset;
2809 Elf_Addr info = rtab[j].r_info;
2811 Elf_Addr P = ((Elf_Addr)targ) + offset;
2812 Elf_Word* pP = (Elf_Word*)P;
2818 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
2819 j, (void*)offset, (void*)info ));
2821 IF_DEBUG(linker,debugBelch( " ZERO" ));
2824 Elf_Sym sym = stab[ELF_R_SYM(info)];
2825 /* First see if it is a local symbol. */
2826 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2827 /* Yes, so we can get the address directly from the ELF symbol
2829 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2831 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2832 + stab[ELF_R_SYM(info)].st_value);
2835 /* No, so look up the name in our global table. */
2836 symbol = strtab + sym.st_name;
2837 S_tmp = lookupSymbol( symbol );
2838 S = (Elf_Addr)S_tmp;
2841 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
2844 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
2847 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
2848 (void*)P, (void*)S, (void*)A ));
2849 checkProddableBlock ( oc, pP );
2853 switch (ELF_R_TYPE(info)) {
2854 # ifdef i386_TARGET_ARCH
2855 case R_386_32: *pP = value; break;
2856 case R_386_PC32: *pP = value - P; break;
2859 errorBelch("%s: unhandled ELF relocation(Rel) type %d\n",
2860 oc->fileName, ELF_R_TYPE(info));
2868 /* Do ELF relocations for which explicit addends are supplied.
2869 sparc-solaris relocations appear to be of this form. */
2871 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2872 Elf_Shdr* shdr, int shnum,
2873 Elf_Sym* stab, char* strtab )
2878 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2879 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2880 int target_shndx = shdr[shnum].sh_info;
2881 int symtab_shndx = shdr[shnum].sh_link;
2883 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2884 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2885 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
2886 target_shndx, symtab_shndx ));
2888 for (j = 0; j < nent; j++) {
2889 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH) || defined(powerpc_TARGET_ARCH)
2890 /* This #ifdef only serves to avoid unused-var warnings. */
2891 Elf_Addr offset = rtab[j].r_offset;
2892 Elf_Addr P = targ + offset;
2894 Elf_Addr info = rtab[j].r_info;
2895 Elf_Addr A = rtab[j].r_addend;
2899 # if defined(sparc_TARGET_ARCH)
2900 Elf_Word* pP = (Elf_Word*)P;
2902 # elif defined(ia64_TARGET_ARCH)
2903 Elf64_Xword *pP = (Elf64_Xword *)P;
2905 # elif defined(powerpc_TARGET_ARCH)
2909 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
2910 j, (void*)offset, (void*)info,
2913 IF_DEBUG(linker,debugBelch( " ZERO" ));
2916 Elf_Sym sym = stab[ELF_R_SYM(info)];
2917 /* First see if it is a local symbol. */
2918 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2919 /* Yes, so we can get the address directly from the ELF symbol
2921 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2923 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2924 + stab[ELF_R_SYM(info)].st_value);
2925 #ifdef ELF_FUNCTION_DESC
2926 /* Make a function descriptor for this function */
2927 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2928 S = allocateFunctionDesc(S + A);
2933 /* No, so look up the name in our global table. */
2934 symbol = strtab + sym.st_name;
2935 S_tmp = lookupSymbol( symbol );
2936 S = (Elf_Addr)S_tmp;
2938 #ifdef ELF_FUNCTION_DESC
2939 /* If a function, already a function descriptor - we would
2940 have to copy it to add an offset. */
2941 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2942 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2946 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
2949 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
2952 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
2953 (void*)P, (void*)S, (void*)A ));
2954 /* checkProddableBlock ( oc, (void*)P ); */
2958 switch (ELF_R_TYPE(info)) {
2959 # if defined(sparc_TARGET_ARCH)
2960 case R_SPARC_WDISP30:
2961 w1 = *pP & 0xC0000000;
2962 w2 = (Elf_Word)((value - P) >> 2);
2963 ASSERT((w2 & 0xC0000000) == 0);
2968 w1 = *pP & 0xFFC00000;
2969 w2 = (Elf_Word)(value >> 10);
2970 ASSERT((w2 & 0xFFC00000) == 0);
2976 w2 = (Elf_Word)(value & 0x3FF);
2977 ASSERT((w2 & ~0x3FF) == 0);
2981 /* According to the Sun documentation:
2983 This relocation type resembles R_SPARC_32, except it refers to an
2984 unaligned word. That is, the word to be relocated must be treated
2985 as four separate bytes with arbitrary alignment, not as a word
2986 aligned according to the architecture requirements.
2988 (JRS: which means that freeloading on the R_SPARC_32 case
2989 is probably wrong, but hey ...)
2993 w2 = (Elf_Word)value;
2996 # elif defined(ia64_TARGET_ARCH)
2997 case R_IA64_DIR64LSB:
2998 case R_IA64_FPTR64LSB:
3001 case R_IA64_PCREL64LSB:
3004 case R_IA64_SEGREL64LSB:
3005 addr = findElfSegment(ehdrC, value);
3008 case R_IA64_GPREL22:
3009 ia64_reloc_gprel22(P, value);
3011 case R_IA64_LTOFF22:
3012 case R_IA64_LTOFF22X:
3013 case R_IA64_LTOFF_FPTR22:
3014 addr = allocateGOTEntry(value);
3015 ia64_reloc_gprel22(P, addr);
3017 case R_IA64_PCREL21B:
3018 ia64_reloc_pcrel21(P, S, oc);
3021 /* This goes with R_IA64_LTOFF22X and points to the load to
3022 * convert into a move. We don't implement relaxation. */
3024 # elif defined(powerpc_TARGET_ARCH)
3025 case R_PPC_ADDR16_LO:
3026 *(Elf32_Half*) P = value;
3029 case R_PPC_ADDR16_HI:
3030 *(Elf32_Half*) P = value >> 16;
3033 case R_PPC_ADDR16_HA:
3034 *(Elf32_Half*) P = (value + 0x8000) >> 16;
3038 *(Elf32_Word *) P = value;
3042 *(Elf32_Word *) P = value - P;
3048 if( delta << 6 >> 6 != delta )
3050 value = makeJumpIsland( oc, ELF_R_SYM(info), value );
3053 if( value == 0 || delta << 6 >> 6 != delta )
3055 barf( "Unable to make ppcJumpIsland for #%d",
3061 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3062 | (delta & 0x3fffffc);
3066 errorBelch("%s: unhandled ELF relocation(RelA) type %d\n",
3067 oc->fileName, ELF_R_TYPE(info));
3076 ocResolve_ELF ( ObjectCode* oc )
3080 Elf_Sym* stab = NULL;
3081 char* ehdrC = (char*)(oc->image);
3082 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
3083 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3085 /* first find "the" symbol table */
3086 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
3088 /* also go find the string table */
3089 strtab = findElfSection ( ehdrC, SHT_STRTAB );
3091 if (stab == NULL || strtab == NULL) {
3092 errorBelch("%s: can't find string or symbol table", oc->fileName);
3096 /* Process the relocation sections. */
3097 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
3098 if (shdr[shnum].sh_type == SHT_REL) {
3099 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
3100 shnum, stab, strtab );
3104 if (shdr[shnum].sh_type == SHT_RELA) {
3105 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
3106 shnum, stab, strtab );
3111 /* Free the local symbol table; we won't need it again. */
3112 freeHashTable(oc->lochash, NULL);
3115 #if defined(powerpc_TARGET_ARCH)
3116 ocFlushInstructionCache( oc );
3124 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
3125 * at the front. The following utility functions pack and unpack instructions, and
3126 * take care of the most common relocations.
3129 #ifdef ia64_TARGET_ARCH
3132 ia64_extract_instruction(Elf64_Xword *target)
3135 int slot = (Elf_Addr)target & 3;
3136 (Elf_Addr)target &= ~3;
3144 return ((w1 >> 5) & 0x1ffffffffff);
3146 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
3150 barf("ia64_extract_instruction: invalid slot %p", target);
3155 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
3157 int slot = (Elf_Addr)target & 3;
3158 (Elf_Addr)target &= ~3;
3163 *target |= value << 5;
3166 *target |= value << 46;
3167 *(target+1) |= value >> 18;
3170 *(target+1) |= value << 23;
3176 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3178 Elf64_Xword instruction;
3179 Elf64_Sxword rel_value;
3181 rel_value = value - gp_val;
3182 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3183 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3185 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3186 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3187 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3188 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3189 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3190 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3194 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3196 Elf64_Xword instruction;
3197 Elf64_Sxword rel_value;
3200 entry = allocatePLTEntry(value, oc);
3202 rel_value = (entry >> 4) - (target >> 4);
3203 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3204 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3206 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3207 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3208 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3209 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3215 * PowerPC ELF specifics
3218 #ifdef powerpc_TARGET_ARCH
3220 static int ocAllocateJumpIslands_ELF( ObjectCode *oc )
3226 ehdr = (Elf_Ehdr *) oc->image;
3227 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
3229 for( i = 0; i < ehdr->e_shnum; i++ )
3230 if( shdr[i].sh_type == SHT_SYMTAB )
3233 if( i == ehdr->e_shnum )
3235 errorBelch( "This ELF file contains no symtab" );
3239 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
3241 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
3242 shdr[i].sh_entsize, sizeof( Elf_Sym ) );
3247 return ocAllocateJumpIslands( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
3250 #endif /* powerpc */
3254 /* --------------------------------------------------------------------------
3256 * ------------------------------------------------------------------------*/
3258 #if defined(OBJFORMAT_MACHO)
3261 Support for MachO linking on Darwin/MacOS X on PowerPC chips
3262 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3264 I hereby formally apologize for the hackish nature of this code.
3265 Things that need to be done:
3266 *) implement ocVerifyImage_MachO
3267 *) add still more sanity checks.
3270 static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
3272 struct mach_header *header = (struct mach_header *) oc->image;
3273 struct load_command *lc = (struct load_command *) (header + 1);
3276 for( i = 0; i < header->ncmds; i++ )
3278 if( lc->cmd == LC_SYMTAB )
3280 // Find out the first and last undefined external
3281 // symbol, so we don't have to allocate too many
3283 struct symtab_command *symLC = (struct symtab_command *) lc;
3284 int min = symLC->nsyms, max = 0;
3285 struct nlist *nlist =
3286 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
3288 for(i=0;i<symLC->nsyms;i++)
3290 if(nlist[i].n_type & N_STAB)
3292 else if(nlist[i].n_type & N_EXT)
3294 if((nlist[i].n_type & N_TYPE) == N_UNDF
3295 && (nlist[i].n_value == 0))
3305 return ocAllocateJumpIslands(oc, max - min + 1, min);
3310 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3312 return ocAllocateJumpIslands(oc,0,0);
3315 static int ocVerifyImage_MachO(ObjectCode* oc)
3317 // FIXME: do some verifying here
3321 static int resolveImports(
3324 struct symtab_command *symLC,
3325 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3326 unsigned long *indirectSyms,
3327 struct nlist *nlist)
3331 for(i=0;i*4<sect->size;i++)
3333 // according to otool, reserved1 contains the first index into the indirect symbol table
3334 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3335 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3338 if((symbol->n_type & N_TYPE) == N_UNDF
3339 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3340 addr = (void*) (symbol->n_value);
3341 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3344 addr = lookupSymbol(nm);
3347 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3351 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3352 ((void**)(image + sect->offset))[i] = addr;
3358 static char* relocateAddress(
3361 struct section* sections,
3362 unsigned long address)
3365 for(i = 0; i < nSections; i++)
3367 if(sections[i].addr <= address
3368 && address < sections[i].addr + sections[i].size)
3370 return oc->image + sections[i].offset + address - sections[i].addr;
3373 barf("Invalid Mach-O file:"
3374 "Address out of bounds while relocating object file");
3378 static int relocateSection(
3381 struct symtab_command *symLC, struct nlist *nlist,
3382 int nSections, struct section* sections, struct section *sect)
3384 struct relocation_info *relocs;
3387 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3389 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3393 relocs = (struct relocation_info*) (image + sect->reloff);
3397 if(relocs[i].r_address & R_SCATTERED)
3399 struct scattered_relocation_info *scat =
3400 (struct scattered_relocation_info*) &relocs[i];
3404 if(scat->r_length == 2)
3406 unsigned long word = 0;
3407 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
3408 checkProddableBlock(oc,wordPtr);
3410 // Step 1: Figure out what the relocated value should be
3411 if(scat->r_type == GENERIC_RELOC_VANILLA)
3413 word = *wordPtr + (unsigned long) relocateAddress(
3420 else if(scat->r_type == PPC_RELOC_SECTDIFF
3421 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
3422 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
3423 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3425 struct scattered_relocation_info *pair =
3426 (struct scattered_relocation_info*) &relocs[i+1];
3428 if(!pair->r_scattered || pair->r_type != PPC_RELOC_PAIR)
3429 barf("Invalid Mach-O file: "
3430 "PPC_RELOC_*_SECTDIFF not followed by PPC_RELOC_PAIR");
3432 word = (unsigned long)
3433 (relocateAddress(oc, nSections, sections, scat->r_value)
3434 - relocateAddress(oc, nSections, sections, pair->r_value));
3437 else if(scat->r_type == PPC_RELOC_HI16
3438 || scat->r_type == PPC_RELOC_LO16
3439 || scat->r_type == PPC_RELOC_HA16
3440 || scat->r_type == PPC_RELOC_LO14)
3441 { // these are generated by label+offset things
3442 struct relocation_info *pair = &relocs[i+1];
3443 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
3444 barf("Invalid Mach-O file: "
3445 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
3447 if(scat->r_type == PPC_RELOC_LO16)
3449 word = ((unsigned short*) wordPtr)[1];
3450 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3452 else if(scat->r_type == PPC_RELOC_LO14)
3454 barf("Unsupported Relocation: PPC_RELOC_LO14");
3455 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
3456 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3458 else if(scat->r_type == PPC_RELOC_HI16)
3460 word = ((unsigned short*) wordPtr)[1] << 16;
3461 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3463 else if(scat->r_type == PPC_RELOC_HA16)
3465 word = ((unsigned short*) wordPtr)[1] << 16;
3466 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3470 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
3476 continue; // ignore the others
3478 if(scat->r_type == GENERIC_RELOC_VANILLA
3479 || scat->r_type == PPC_RELOC_SECTDIFF)
3483 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
3485 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3487 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
3489 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3491 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
3493 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3494 + ((word & (1<<15)) ? 1 : 0);
3499 continue; // FIXME: I hope it's OK to ignore all the others.
3503 struct relocation_info *reloc = &relocs[i];
3504 if(reloc->r_pcrel && !reloc->r_extern)
3507 if(reloc->r_length == 2)
3509 unsigned long word = 0;
3510 unsigned long jumpIsland = 0;
3511 long offsetToJumpIsland;
3513 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3514 checkProddableBlock(oc,wordPtr);
3516 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3520 else if(reloc->r_type == PPC_RELOC_LO16)
3522 word = ((unsigned short*) wordPtr)[1];
3523 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3525 else if(reloc->r_type == PPC_RELOC_HI16)
3527 word = ((unsigned short*) wordPtr)[1] << 16;
3528 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3530 else if(reloc->r_type == PPC_RELOC_HA16)
3532 word = ((unsigned short*) wordPtr)[1] << 16;
3533 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3535 else if(reloc->r_type == PPC_RELOC_BR24)
3538 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
3542 if(!reloc->r_extern)
3545 sections[reloc->r_symbolnum-1].offset
3546 - sections[reloc->r_symbolnum-1].addr
3553 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3554 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3555 unsigned long symbolAddress = (unsigned long) (lookupSymbol(nm));
3558 errorBelch("\nunknown symbol `%s'", nm);
3564 // In the .o file, this should be a relative jump to NULL
3565 // and we'll change it to a jump to a relative jump to the symbol
3566 ASSERT(-word == reloc->r_address);
3567 word = symbolAddress;
3568 jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,word);
3569 word -= ((long)image) + sect->offset + reloc->r_address;
3572 offsetToJumpIsland = jumpIsland
3573 - (((long)image) + sect->offset + reloc->r_address);
3578 word += symbolAddress;
3582 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3587 else if(reloc->r_type == PPC_RELOC_LO16)
3589 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3592 else if(reloc->r_type == PPC_RELOC_HI16)
3594 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3597 else if(reloc->r_type == PPC_RELOC_HA16)
3599 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3600 + ((word & (1<<15)) ? 1 : 0);
3603 else if(reloc->r_type == PPC_RELOC_BR24)
3605 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3607 // The branch offset is too large.
3608 // Therefore, we try to use a jump island.
3611 barf("unconditional relative branch out of range: "
3612 "no jump island available");
3615 word = offsetToJumpIsland;
3616 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3617 barf("unconditional relative branch out of range: "
3618 "jump island out of range");
3620 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3624 barf("\nunknown relocation %d",reloc->r_type);
3631 static int ocGetNames_MachO(ObjectCode* oc)
3633 char *image = (char*) oc->image;
3634 struct mach_header *header = (struct mach_header*) image;
3635 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3636 unsigned i,curSymbol;
3637 struct segment_command *segLC = NULL;
3638 struct section *sections;
3639 struct symtab_command *symLC = NULL;
3640 struct nlist *nlist;
3641 unsigned long commonSize = 0;
3642 char *commonStorage = NULL;
3643 unsigned long commonCounter;
3645 for(i=0;i<header->ncmds;i++)
3647 if(lc->cmd == LC_SEGMENT)
3648 segLC = (struct segment_command*) lc;
3649 else if(lc->cmd == LC_SYMTAB)
3650 symLC = (struct symtab_command*) lc;
3651 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3654 sections = (struct section*) (segLC+1);
3655 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
3658 for(i=0;i<segLC->nsects;i++)
3660 if(sections[i].size == 0)
3663 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
3665 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
3666 "ocGetNames_MachO(common symbols)");
3667 sections[i].offset = zeroFillArea - image;
3670 if(!strcmp(sections[i].sectname,"__text"))
3671 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3672 (void*) (image + sections[i].offset),
3673 (void*) (image + sections[i].offset + sections[i].size));
3674 else if(!strcmp(sections[i].sectname,"__const"))
3675 addSection(oc, SECTIONKIND_RWDATA,
3676 (void*) (image + sections[i].offset),
3677 (void*) (image + sections[i].offset + sections[i].size));
3678 else if(!strcmp(sections[i].sectname,"__data"))
3679 addSection(oc, SECTIONKIND_RWDATA,
3680 (void*) (image + sections[i].offset),
3681 (void*) (image + sections[i].offset + sections[i].size));
3682 else if(!strcmp(sections[i].sectname,"__bss")
3683 || !strcmp(sections[i].sectname,"__common"))
3684 addSection(oc, SECTIONKIND_RWDATA,
3685 (void*) (image + sections[i].offset),
3686 (void*) (image + sections[i].offset + sections[i].size));
3688 addProddableBlock(oc, (void*) (image + sections[i].offset),
3692 // count external symbols defined here
3696 for(i=0;i<symLC->nsyms;i++)
3698 if(nlist[i].n_type & N_STAB)
3700 else if(nlist[i].n_type & N_EXT)
3702 if((nlist[i].n_type & N_TYPE) == N_UNDF
3703 && (nlist[i].n_value != 0))
3705 commonSize += nlist[i].n_value;
3708 else if((nlist[i].n_type & N_TYPE) == N_SECT)
3713 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3714 "ocGetNames_MachO(oc->symbols)");
3719 for(i=0;i<symLC->nsyms;i++)
3721 if(nlist[i].n_type & N_STAB)
3723 else if((nlist[i].n_type & N_TYPE) == N_SECT)
3725 if(nlist[i].n_type & N_EXT)
3727 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3728 ghciInsertStrHashTable(oc->fileName, symhash, nm,
3730 + sections[nlist[i].n_sect-1].offset
3731 - sections[nlist[i].n_sect-1].addr
3732 + nlist[i].n_value);
3733 oc->symbols[curSymbol++] = nm;
3737 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3738 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm,
3740 + sections[nlist[i].n_sect-1].offset
3741 - sections[nlist[i].n_sect-1].addr
3742 + nlist[i].n_value);
3748 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3749 commonCounter = (unsigned long)commonStorage;
3752 for(i=0;i<symLC->nsyms;i++)
3754 if((nlist[i].n_type & N_TYPE) == N_UNDF
3755 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3757 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3758 unsigned long sz = nlist[i].n_value;
3760 nlist[i].n_value = commonCounter;
3762 ghciInsertStrHashTable(oc->fileName, symhash, nm,
3763 (void*)commonCounter);
3764 oc->symbols[curSymbol++] = nm;
3766 commonCounter += sz;
3773 static int ocResolve_MachO(ObjectCode* oc)
3775 char *image = (char*) oc->image;
3776 struct mach_header *header = (struct mach_header*) image;
3777 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3779 struct segment_command *segLC = NULL;
3780 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3781 struct symtab_command *symLC = NULL;
3782 struct dysymtab_command *dsymLC = NULL;
3783 struct nlist *nlist;
3785 for(i=0;i<header->ncmds;i++)
3787 if(lc->cmd == LC_SEGMENT)
3788 segLC = (struct segment_command*) lc;
3789 else if(lc->cmd == LC_SYMTAB)
3790 symLC = (struct symtab_command*) lc;
3791 else if(lc->cmd == LC_DYSYMTAB)
3792 dsymLC = (struct dysymtab_command*) lc;
3793 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3796 sections = (struct section*) (segLC+1);
3797 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
3800 for(i=0;i<segLC->nsects;i++)
3802 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3803 la_ptrs = §ions[i];
3804 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3805 nl_ptrs = §ions[i];
3810 unsigned long *indirectSyms
3811 = (unsigned long*) (image + dsymLC->indirectsymoff);
3814 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3817 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3821 for(i=0;i<segLC->nsects;i++)
3823 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
3827 /* Free the local symbol table; we won't need it again. */
3828 freeHashTable(oc->lochash, NULL);
3831 #if defined (powerpc_TARGET_ARCH)
3832 ocFlushInstructionCache( oc );
3839 * The Mach-O object format uses leading underscores. But not everywhere.
3840 * There is a small number of runtime support functions defined in
3841 * libcc_dynamic.a whose name does not have a leading underscore.
3842 * As a consequence, we can't get their address from C code.
3843 * We have to use inline assembler just to take the address of a function.
3847 static void machoInitSymbolsWithoutUnderscore()
3849 extern void* symbolsWithoutUnderscore[];
3850 void **p = symbolsWithoutUnderscore;
3851 __asm__ volatile(".data\n_symbolsWithoutUnderscore:");
3855 __asm__ volatile(".long " # x);
3857 RTS_MACHO_NOUNDERLINE_SYMBOLS
3859 __asm__ volatile(".text");
3863 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
3865 RTS_MACHO_NOUNDERLINE_SYMBOLS