1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 2000-2004
7 * ---------------------------------------------------------------------------*/
10 #include "PosixSource.h"
13 /* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and
14 MREMAP_MAYMOVE from <sys/mman.h>.
25 #include "LinkerInternals.h"
30 #ifdef HAVE_SYS_TYPES_H
31 #include <sys/types.h>
37 #ifdef HAVE_SYS_STAT_H
41 #if defined(HAVE_DLFCN_H)
45 #if defined(cygwin32_HOST_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_HOST_ARCH) || defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
66 #if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
74 #if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
75 # define OBJFORMAT_ELF
76 #elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
77 # define OBJFORMAT_PEi386
80 #elif defined(darwin_HOST_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_HOST_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_HOST_OS)
138 #define RTS_POSIX_ONLY_SYMBOLS \
139 SymX(stg_sig_install) \
143 #if defined (cygwin32_HOST_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_HOST_OS)
228 #define RTS_MINGW_ONLY_SYMBOLS /**/
229 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
230 #else /* defined(mingw32_HOST_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) \
310 RTS_MINGW_EXTRA_SYMS \
315 # define MAIN_CAP_SYM SymX(MainCapability)
317 # define MAIN_CAP_SYM
320 #if !defined(mingw32_HOST_OS)
321 #define RTS_USER_SIGNALS_SYMBOLS \
322 SymX(startSignalHandler) \
323 SymX(setIOManagerPipe)
325 #define RTS_USER_SIGNALS_SYMBOLS /* nothing */
328 #ifdef TABLES_NEXT_TO_CODE
329 #define RTS_RET_SYMBOLS /* nothing */
331 #define RTS_RET_SYMBOLS \
332 SymX(stg_enter_ret) \
333 SymX(stg_gc_fun_ret) \
341 SymX(stg_ap_pv_ret) \
342 SymX(stg_ap_pp_ret) \
343 SymX(stg_ap_ppv_ret) \
344 SymX(stg_ap_ppp_ret) \
345 SymX(stg_ap_pppv_ret) \
346 SymX(stg_ap_pppp_ret) \
347 SymX(stg_ap_ppppp_ret) \
348 SymX(stg_ap_pppppp_ret)
351 #define RTS_SYMBOLS \
355 SymX(stg_enter_info) \
356 SymX(stg_gc_void_info) \
357 SymX(__stg_gc_enter_1) \
358 SymX(stg_gc_noregs) \
359 SymX(stg_gc_unpt_r1_info) \
360 SymX(stg_gc_unpt_r1) \
361 SymX(stg_gc_unbx_r1_info) \
362 SymX(stg_gc_unbx_r1) \
363 SymX(stg_gc_f1_info) \
365 SymX(stg_gc_d1_info) \
367 SymX(stg_gc_l1_info) \
370 SymX(stg_gc_fun_info) \
372 SymX(stg_gc_gen_info) \
373 SymX(stg_gc_gen_hp) \
375 SymX(stg_gen_yield) \
376 SymX(stg_yield_noregs) \
377 SymX(stg_yield_to_interpreter) \
378 SymX(stg_gen_block) \
379 SymX(stg_block_noregs) \
381 SymX(stg_block_takemvar) \
382 SymX(stg_block_putmvar) \
383 SymX(stg_seq_frame_info) \
385 SymX(MallocFailHook) \
387 SymX(OutOfHeapHook) \
388 SymX(StackOverflowHook) \
389 SymX(__encodeDouble) \
390 SymX(__encodeFloat) \
394 SymX(__gmpz_cmp_si) \
395 SymX(__gmpz_cmp_ui) \
396 SymX(__gmpz_get_si) \
397 SymX(__gmpz_get_ui) \
398 SymX(__int_encodeDouble) \
399 SymX(__int_encodeFloat) \
400 SymX(andIntegerzh_fast) \
401 SymX(atomicallyzh_fast) \
405 SymX(blockAsyncExceptionszh_fast) \
407 SymX(catchRetryzh_fast) \
408 SymX(catchSTMzh_fast) \
409 SymX(closure_flags) \
411 SymX(cmpIntegerzh_fast) \
412 SymX(cmpIntegerIntzh_fast) \
413 SymX(complementIntegerzh_fast) \
414 SymX(createAdjustor) \
415 SymX(decodeDoublezh_fast) \
416 SymX(decodeFloatzh_fast) \
419 SymX(deRefWeakzh_fast) \
420 SymX(deRefStablePtrzh_fast) \
421 SymX(divExactIntegerzh_fast) \
422 SymX(divModIntegerzh_fast) \
425 SymX(forkOS_createThread) \
426 SymX(freeHaskellFunctionPtr) \
427 SymX(freeStablePtr) \
428 SymX(gcdIntegerzh_fast) \
429 SymX(gcdIntegerIntzh_fast) \
430 SymX(gcdIntzh_fast) \
439 SymX(hs_perform_gc) \
440 SymX(hs_free_stable_ptr) \
441 SymX(hs_free_fun_ptr) \
443 SymX(int2Integerzh_fast) \
444 SymX(integer2Intzh_fast) \
445 SymX(integer2Wordzh_fast) \
446 SymX(isCurrentThreadBoundzh_fast) \
447 SymX(isDoubleDenormalized) \
448 SymX(isDoubleInfinite) \
450 SymX(isDoubleNegativeZero) \
451 SymX(isEmptyMVarzh_fast) \
452 SymX(isFloatDenormalized) \
453 SymX(isFloatInfinite) \
455 SymX(isFloatNegativeZero) \
456 SymX(killThreadzh_fast) \
459 SymX(makeStablePtrzh_fast) \
460 SymX(minusIntegerzh_fast) \
461 SymX(mkApUpd0zh_fast) \
462 SymX(myThreadIdzh_fast) \
463 SymX(labelThreadzh_fast) \
464 SymX(newArrayzh_fast) \
465 SymX(newBCOzh_fast) \
466 SymX(newByteArrayzh_fast) \
467 SymX_redirect(newCAF, newDynCAF) \
468 SymX(newMVarzh_fast) \
469 SymX(newMutVarzh_fast) \
470 SymX(newTVarzh_fast) \
471 SymX(atomicModifyMutVarzh_fast) \
472 SymX(newPinnedByteArrayzh_fast) \
473 SymX(orIntegerzh_fast) \
475 SymX(performMajorGC) \
476 SymX(plusIntegerzh_fast) \
479 SymX(putMVarzh_fast) \
480 SymX(quotIntegerzh_fast) \
481 SymX(quotRemIntegerzh_fast) \
483 SymX(raiseIOzh_fast) \
484 SymX(readTVarzh_fast) \
485 SymX(remIntegerzh_fast) \
486 SymX(resetNonBlockingFd) \
491 SymX(rts_checkSchedStatus) \
494 SymX(rts_evalLazyIO) \
495 SymX(rts_evalStableIO) \
499 SymX(rts_getDouble) \
504 SymX(rts_getFunPtr) \
505 SymX(rts_getStablePtr) \
506 SymX(rts_getThreadId) \
508 SymX(rts_getWord32) \
521 SymX(rts_mkStablePtr) \
529 SymX(rtsSupportsBoundThreads) \
531 SymX(__hscore_get_saved_termios) \
532 SymX(__hscore_set_saved_termios) \
534 SymX(startupHaskell) \
535 SymX(shutdownHaskell) \
536 SymX(shutdownHaskellAndExit) \
537 SymX(stable_ptr_table) \
538 SymX(stackOverflow) \
539 SymX(stg_CAF_BLACKHOLE_info) \
540 SymX(awakenBlockedQueue) \
541 SymX(stg_CHARLIKE_closure) \
542 SymX(stg_EMPTY_MVAR_info) \
543 SymX(stg_IND_STATIC_info) \
544 SymX(stg_INTLIKE_closure) \
545 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
546 SymX(stg_MUT_ARR_PTRS_FROZEN0_info) \
547 SymX(stg_WEAK_info) \
548 SymX(stg_ap_0_info) \
549 SymX(stg_ap_v_info) \
550 SymX(stg_ap_f_info) \
551 SymX(stg_ap_d_info) \
552 SymX(stg_ap_l_info) \
553 SymX(stg_ap_n_info) \
554 SymX(stg_ap_p_info) \
555 SymX(stg_ap_pv_info) \
556 SymX(stg_ap_pp_info) \
557 SymX(stg_ap_ppv_info) \
558 SymX(stg_ap_ppp_info) \
559 SymX(stg_ap_pppv_info) \
560 SymX(stg_ap_pppp_info) \
561 SymX(stg_ap_ppppp_info) \
562 SymX(stg_ap_pppppp_info) \
563 SymX(stg_ap_1_upd_info) \
564 SymX(stg_ap_2_upd_info) \
565 SymX(stg_ap_3_upd_info) \
566 SymX(stg_ap_4_upd_info) \
567 SymX(stg_ap_5_upd_info) \
568 SymX(stg_ap_6_upd_info) \
569 SymX(stg_ap_7_upd_info) \
571 SymX(stg_sel_0_upd_info) \
572 SymX(stg_sel_10_upd_info) \
573 SymX(stg_sel_11_upd_info) \
574 SymX(stg_sel_12_upd_info) \
575 SymX(stg_sel_13_upd_info) \
576 SymX(stg_sel_14_upd_info) \
577 SymX(stg_sel_15_upd_info) \
578 SymX(stg_sel_1_upd_info) \
579 SymX(stg_sel_2_upd_info) \
580 SymX(stg_sel_3_upd_info) \
581 SymX(stg_sel_4_upd_info) \
582 SymX(stg_sel_5_upd_info) \
583 SymX(stg_sel_6_upd_info) \
584 SymX(stg_sel_7_upd_info) \
585 SymX(stg_sel_8_upd_info) \
586 SymX(stg_sel_9_upd_info) \
587 SymX(stg_upd_frame_info) \
588 SymX(suspendThread) \
589 SymX(takeMVarzh_fast) \
590 SymX(timesIntegerzh_fast) \
591 SymX(tryPutMVarzh_fast) \
592 SymX(tryTakeMVarzh_fast) \
593 SymX(unblockAsyncExceptionszh_fast) \
595 SymX(unsafeThawArrayzh_fast) \
596 SymX(waitReadzh_fast) \
597 SymX(waitWritezh_fast) \
598 SymX(word2Integerzh_fast) \
599 SymX(writeTVarzh_fast) \
600 SymX(xorIntegerzh_fast) \
602 RTS_USER_SIGNALS_SYMBOLS
604 #ifdef SUPPORT_LONG_LONGS
605 #define RTS_LONG_LONG_SYMS \
606 SymX(int64ToIntegerzh_fast) \
607 SymX(word64ToIntegerzh_fast)
609 #define RTS_LONG_LONG_SYMS /* nothing */
612 // 64-bit support functions in libgcc.a
613 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
614 #define RTS_LIBGCC_SYMBOLS \
624 #elif defined(ia64_HOST_ARCH)
625 #define RTS_LIBGCC_SYMBOLS \
633 #define RTS_LIBGCC_SYMBOLS
636 #ifdef darwin_HOST_OS
637 // Symbols that don't have a leading underscore
638 // on Mac OS X. They have to receive special treatment,
639 // see machoInitSymbolsWithoutUnderscore()
640 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
645 /* entirely bogus claims about types of these symbols */
646 #define Sym(vvv) extern void vvv(void);
647 #define SymX(vvv) /**/
648 #define SymX_redirect(vvv,xxx) /**/
652 RTS_POSIX_ONLY_SYMBOLS
653 RTS_MINGW_ONLY_SYMBOLS
654 RTS_CYGWIN_ONLY_SYMBOLS
660 #ifdef LEADING_UNDERSCORE
661 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
663 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
666 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
668 #define SymX(vvv) Sym(vvv)
670 // SymX_redirect allows us to redirect references to one symbol to
671 // another symbol. See newCAF/newDynCAF for an example.
672 #define SymX_redirect(vvv,xxx) \
673 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
676 static RtsSymbolVal rtsSyms[] = {
680 RTS_POSIX_ONLY_SYMBOLS
681 RTS_MINGW_ONLY_SYMBOLS
682 RTS_CYGWIN_ONLY_SYMBOLS
684 { 0, 0 } /* sentinel */
687 /* -----------------------------------------------------------------------------
688 * Insert symbols into hash tables, checking for duplicates.
690 static void ghciInsertStrHashTable ( char* obj_name,
696 if (lookupHashTable(table, (StgWord)key) == NULL)
698 insertStrHashTable(table, (StgWord)key, data);
703 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
705 "whilst processing object file\n"
707 "This could be caused by:\n"
708 " * Loading two different object files which export the same symbol\n"
709 " * Specifying the same object file twice on the GHCi command line\n"
710 " * An incorrect `package.conf' entry, causing some object to be\n"
712 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
721 /* -----------------------------------------------------------------------------
722 * initialize the object linker
726 static int linker_init_done = 0 ;
728 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
729 static void *dl_prog_handle;
732 /* dlopen(NULL,..) doesn't work so we grab libc explicitly */
733 #if defined(openbsd_HOST_OS)
734 static void *dl_libc_handle;
742 /* Make initLinker idempotent, so we can call it
743 before evey relevant operation; that means we
744 don't need to initialise the linker separately */
745 if (linker_init_done == 1) { return; } else {
746 linker_init_done = 1;
749 symhash = allocStrHashTable();
751 /* populate the symbol table with stuff from the RTS */
752 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
753 ghciInsertStrHashTable("(GHCi built-in symbols)",
754 symhash, sym->lbl, sym->addr);
756 # if defined(OBJFORMAT_MACHO)
757 machoInitSymbolsWithoutUnderscore();
760 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
761 # if defined(RTLD_DEFAULT)
762 dl_prog_handle = RTLD_DEFAULT;
764 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
765 # if defined(openbsd_HOST_OS)
766 dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
768 # endif /* RTLD_DEFAULT */
772 /* -----------------------------------------------------------------------------
773 * Loading DLL or .so dynamic libraries
774 * -----------------------------------------------------------------------------
776 * Add a DLL from which symbols may be found. In the ELF case, just
777 * do RTLD_GLOBAL-style add, so no further messing around needs to
778 * happen in order that symbols in the loaded .so are findable --
779 * lookupSymbol() will subsequently see them by dlsym on the program's
780 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
782 * In the PEi386 case, open the DLLs and put handles to them in a
783 * linked list. When looking for a symbol, try all handles in the
784 * list. This means that we need to load even DLLs that are guaranteed
785 * to be in the ghc.exe image already, just so we can get a handle
786 * to give to loadSymbol, so that we can find the symbols. For such
787 * libraries, the LoadLibrary call should be a no-op except for returning
792 #if defined(OBJFORMAT_PEi386)
793 /* A record for storing handles into DLLs. */
798 struct _OpenedDLL* next;
803 /* A list thereof. */
804 static OpenedDLL* opened_dlls = NULL;
808 addDLL( char *dll_name )
810 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
811 /* ------------------- ELF DLL loader ------------------- */
817 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
820 /* dlopen failed; return a ptr to the error msg. */
822 if (errmsg == NULL) errmsg = "addDLL: unknown error";
829 # elif defined(OBJFORMAT_PEi386)
830 /* ------------------- Win32 DLL loader ------------------- */
838 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
840 /* See if we've already got it, and ignore if so. */
841 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
842 if (0 == strcmp(o_dll->name, dll_name))
846 /* The file name has no suffix (yet) so that we can try
847 both foo.dll and foo.drv
849 The documentation for LoadLibrary says:
850 If no file name extension is specified in the lpFileName
851 parameter, the default library extension .dll is
852 appended. However, the file name string can include a trailing
853 point character (.) to indicate that the module name has no
856 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
857 sprintf(buf, "%s.DLL", dll_name);
858 instance = LoadLibrary(buf);
859 if (instance == NULL) {
860 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
861 instance = LoadLibrary(buf);
862 if (instance == NULL) {
865 /* LoadLibrary failed; return a ptr to the error msg. */
866 return "addDLL: unknown error";
871 /* Add this DLL to the list of DLLs in which to search for symbols. */
872 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
873 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
874 strcpy(o_dll->name, dll_name);
875 o_dll->instance = instance;
876 o_dll->next = opened_dlls;
881 barf("addDLL: not implemented on this platform");
885 /* -----------------------------------------------------------------------------
886 * lookup a symbol in the hash table
889 lookupSymbol( char *lbl )
893 ASSERT(symhash != NULL);
894 val = lookupStrHashTable(symhash, lbl);
897 # if defined(OBJFORMAT_ELF)
898 # if defined(openbsd_HOST_OS)
899 val = dlsym(dl_prog_handle, lbl);
900 return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
901 # else /* not openbsd */
902 return dlsym(dl_prog_handle, lbl);
904 # elif defined(OBJFORMAT_MACHO)
905 if(NSIsSymbolNameDefined(lbl)) {
906 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
907 return NSAddressOfSymbol(symbol);
911 # elif defined(OBJFORMAT_PEi386)
914 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
915 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
917 /* HACK: if the name has an initial underscore, try stripping
918 it off & look that up first. I've yet to verify whether there's
919 a Rule that governs whether an initial '_' *should always* be
920 stripped off when mapping from import lib name to the DLL name.
922 sym = GetProcAddress(o_dll->instance, (lbl+1));
924 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
928 sym = GetProcAddress(o_dll->instance, lbl);
930 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
945 __attribute((unused))
947 lookupLocalSymbol( ObjectCode* oc, char *lbl )
951 val = lookupStrHashTable(oc->lochash, lbl);
961 /* -----------------------------------------------------------------------------
962 * Debugging aid: look in GHCi's object symbol tables for symbols
963 * within DELTA bytes of the specified address, and show their names.
966 void ghci_enquire ( char* addr );
968 void ghci_enquire ( char* addr )
973 const int DELTA = 64;
978 for (oc = objects; oc; oc = oc->next) {
979 for (i = 0; i < oc->n_symbols; i++) {
980 sym = oc->symbols[i];
981 if (sym == NULL) continue;
982 // debugBelch("enquire %p %p\n", sym, oc->lochash);
984 if (oc->lochash != NULL) {
985 a = lookupStrHashTable(oc->lochash, sym);
988 a = lookupStrHashTable(symhash, sym);
991 // debugBelch("ghci_enquire: can't find %s\n", sym);
993 else if (addr-DELTA <= a && a <= addr+DELTA) {
994 debugBelch("%p + %3d == `%s'\n", addr, a - addr, sym);
1001 #ifdef ia64_HOST_ARCH
1002 static unsigned int PLTSize(void);
1005 /* -----------------------------------------------------------------------------
1006 * Load an obj (populate the global symbol table, but don't resolve yet)
1008 * Returns: 1 if ok, 0 on error.
1011 loadObj( char *path )
1018 void *map_addr = NULL;
1025 /* debugBelch("loadObj %s\n", path ); */
1027 /* Check that we haven't already loaded this object.
1028 Ignore requests to load multiple times */
1032 for (o = objects; o; o = o->next) {
1033 if (0 == strcmp(o->fileName, path)) {
1035 break; /* don't need to search further */
1039 IF_DEBUG(linker, debugBelch(
1040 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1041 "same object file twice:\n"
1043 "GHCi will ignore this, but be warned.\n"
1045 return 1; /* success */
1049 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1051 # if defined(OBJFORMAT_ELF)
1052 oc->formatName = "ELF";
1053 # elif defined(OBJFORMAT_PEi386)
1054 oc->formatName = "PEi386";
1055 # elif defined(OBJFORMAT_MACHO)
1056 oc->formatName = "Mach-O";
1059 barf("loadObj: not implemented on this platform");
1062 r = stat(path, &st);
1063 if (r == -1) { return 0; }
1065 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1066 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1067 strcpy(oc->fileName, path);
1069 oc->fileSize = st.st_size;
1071 oc->sections = NULL;
1072 oc->lochash = allocStrHashTable();
1073 oc->proddables = NULL;
1075 /* chain it onto the list of objects */
1080 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1082 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1084 #if defined(openbsd_HOST_OS)
1085 fd = open(path, O_RDONLY, S_IRUSR);
1087 fd = open(path, O_RDONLY);
1090 barf("loadObj: can't open `%s'", path);
1092 pagesize = getpagesize();
1094 #ifdef ia64_HOST_ARCH
1095 /* The PLT needs to be right before the object */
1096 n = ROUND_UP(PLTSize(), pagesize);
1097 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1098 if (oc->plt == MAP_FAILED)
1099 barf("loadObj: can't allocate PLT");
1102 map_addr = oc->plt + n;
1105 n = ROUND_UP(oc->fileSize, pagesize);
1107 /* Link objects into the lower 2Gb on x86_64. GHC assumes the
1108 * small memory model on this architecture (see gcc docs,
1111 #ifdef x86_64_HOST_ARCH
1112 #define EXTRA_MAP_FLAGS MAP_32BIT
1114 #define EXTRA_MAP_FLAGS 0
1117 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE,
1118 MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
1119 if (oc->image == MAP_FAILED)
1120 barf("loadObj: can't map `%s'", path);
1124 #else /* !USE_MMAP */
1126 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1128 /* load the image into memory */
1129 f = fopen(path, "rb");
1131 barf("loadObj: can't read `%s'", path);
1133 n = fread ( oc->image, 1, oc->fileSize, f );
1134 if (n != oc->fileSize)
1135 barf("loadObj: error whilst reading `%s'", path);
1139 #endif /* USE_MMAP */
1141 # if defined(OBJFORMAT_MACHO)
1142 r = ocAllocateJumpIslands_MachO ( oc );
1143 if (!r) { return r; }
1144 # elif defined(OBJFORMAT_ELF) && defined(powerpc_HOST_ARCH)
1145 r = ocAllocateJumpIslands_ELF ( oc );
1146 if (!r) { return r; }
1149 /* verify the in-memory image */
1150 # if defined(OBJFORMAT_ELF)
1151 r = ocVerifyImage_ELF ( oc );
1152 # elif defined(OBJFORMAT_PEi386)
1153 r = ocVerifyImage_PEi386 ( oc );
1154 # elif defined(OBJFORMAT_MACHO)
1155 r = ocVerifyImage_MachO ( oc );
1157 barf("loadObj: no verify method");
1159 if (!r) { return r; }
1161 /* build the symbol list for this image */
1162 # if defined(OBJFORMAT_ELF)
1163 r = ocGetNames_ELF ( oc );
1164 # elif defined(OBJFORMAT_PEi386)
1165 r = ocGetNames_PEi386 ( oc );
1166 # elif defined(OBJFORMAT_MACHO)
1167 r = ocGetNames_MachO ( oc );
1169 barf("loadObj: no getNames method");
1171 if (!r) { return r; }
1173 /* loaded, but not resolved yet */
1174 oc->status = OBJECT_LOADED;
1179 /* -----------------------------------------------------------------------------
1180 * resolve all the currently unlinked objects in memory
1182 * Returns: 1 if ok, 0 on error.
1192 for (oc = objects; oc; oc = oc->next) {
1193 if (oc->status != OBJECT_RESOLVED) {
1194 # if defined(OBJFORMAT_ELF)
1195 r = ocResolve_ELF ( oc );
1196 # elif defined(OBJFORMAT_PEi386)
1197 r = ocResolve_PEi386 ( oc );
1198 # elif defined(OBJFORMAT_MACHO)
1199 r = ocResolve_MachO ( oc );
1201 barf("resolveObjs: not implemented on this platform");
1203 if (!r) { return r; }
1204 oc->status = OBJECT_RESOLVED;
1210 /* -----------------------------------------------------------------------------
1211 * delete an object from the pool
1214 unloadObj( char *path )
1216 ObjectCode *oc, *prev;
1218 ASSERT(symhash != NULL);
1219 ASSERT(objects != NULL);
1224 for (oc = objects; oc; prev = oc, oc = oc->next) {
1225 if (!strcmp(oc->fileName,path)) {
1227 /* Remove all the mappings for the symbols within this
1232 for (i = 0; i < oc->n_symbols; i++) {
1233 if (oc->symbols[i] != NULL) {
1234 removeStrHashTable(symhash, oc->symbols[i], NULL);
1242 prev->next = oc->next;
1245 /* We're going to leave this in place, in case there are
1246 any pointers from the heap into it: */
1247 /* stgFree(oc->image); */
1248 stgFree(oc->fileName);
1249 stgFree(oc->symbols);
1250 stgFree(oc->sections);
1251 /* The local hash table should have been freed at the end
1252 of the ocResolve_ call on it. */
1253 ASSERT(oc->lochash == NULL);
1259 errorBelch("unloadObj: can't find `%s' to unload", path);
1263 /* -----------------------------------------------------------------------------
1264 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1265 * which may be prodded during relocation, and abort if we try and write
1266 * outside any of these.
1268 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1271 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1272 /* debugBelch("aPB %p %p %d\n", oc, start, size); */
1276 pb->next = oc->proddables;
1277 oc->proddables = pb;
1280 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1283 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1284 char* s = (char*)(pb->start);
1285 char* e = s + pb->size - 1;
1286 char* a = (char*)addr;
1287 /* Assumes that the biggest fixup involves a 4-byte write. This
1288 probably needs to be changed to 8 (ie, +7) on 64-bit
1290 if (a >= s && (a+3) <= e) return;
1292 barf("checkProddableBlock: invalid fixup in runtime linker");
1295 /* -----------------------------------------------------------------------------
1296 * Section management.
1298 static void addSection ( ObjectCode* oc, SectionKind kind,
1299 void* start, void* end )
1301 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1305 s->next = oc->sections;
1308 debugBelch("addSection: %p-%p (size %d), kind %d\n",
1309 start, ((char*)end)-1, end - start + 1, kind );
1314 /* --------------------------------------------------------------------------
1315 * PowerPC specifics (jump islands)
1316 * ------------------------------------------------------------------------*/
1318 #if defined(powerpc_HOST_ARCH)
1321 ocAllocateJumpIslands
1323 Allocate additional space at the end of the object file image to make room
1326 PowerPC relative branch instructions have a 24 bit displacement field.
1327 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
1328 If a particular imported symbol is outside this range, we have to redirect
1329 the jump to a short piece of new code that just loads the 32bit absolute
1330 address and jumps there.
1331 This function just allocates space for one 16 byte ppcJumpIsland for every
1332 undefined symbol in the object file. The code for the islands is filled in by
1333 makeJumpIsland below.
1336 static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first )
1345 // round up to the nearest 4
1346 aligned = (oc->fileSize + 3) & ~3;
1349 #ifndef linux_HOST_OS /* mremap is a linux extension */
1350 #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined
1353 pagesize = getpagesize();
1354 n = ROUND_UP( oc->fileSize, pagesize );
1355 m = ROUND_UP( aligned + sizeof (ppcJumpIsland) * count, pagesize );
1357 /* The effect of this mremap() call is only the ensure that we have
1358 * a sufficient number of virtually contiguous pages. As returned from
1359 * mremap, the pages past the end of the file are not backed. We give
1360 * them a backing by using MAP_FIXED to map in anonymous pages.
1362 if( (oc->image = mremap( oc->image, n, m, MREMAP_MAYMOVE )) == MAP_FAILED )
1364 errorBelch( "Unable to mremap for Jump Islands\n" );
1368 if( mmap( oc->image + n, m - n, PROT_READ | PROT_WRITE | PROT_EXEC,
1369 MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, 0, 0 ) == MAP_FAILED )
1371 errorBelch( "Unable to mmap( MAP_FIXED ) for Jump Islands\n" );
1376 oc->image = stgReallocBytes( oc->image,
1377 aligned + sizeof (ppcJumpIsland) * count,
1378 "ocAllocateJumpIslands" );
1379 #endif /* USE_MMAP */
1381 oc->jump_islands = (ppcJumpIsland *) (oc->image + aligned);
1382 memset( oc->jump_islands, 0, sizeof (ppcJumpIsland) * count );
1385 oc->jump_islands = NULL;
1387 oc->island_start_symbol = first;
1388 oc->n_islands = count;
1393 static unsigned long makeJumpIsland( ObjectCode* oc,
1394 unsigned long symbolNumber,
1395 unsigned long target )
1397 ppcJumpIsland *island;
1399 if( symbolNumber < oc->island_start_symbol ||
1400 symbolNumber - oc->island_start_symbol > oc->n_islands)
1403 island = &oc->jump_islands[symbolNumber - oc->island_start_symbol];
1405 // lis r12, hi16(target)
1406 island->lis_r12 = 0x3d80;
1407 island->hi_addr = target >> 16;
1409 // ori r12, r12, lo16(target)
1410 island->ori_r12_r12 = 0x618c;
1411 island->lo_addr = target & 0xffff;
1414 island->mtctr_r12 = 0x7d8903a6;
1417 island->bctr = 0x4e800420;
1419 return (unsigned long) island;
1423 ocFlushInstructionCache
1425 Flush the data & instruction caches.
1426 Because the PPC has split data/instruction caches, we have to
1427 do that whenever we modify code at runtime.
1430 static void ocFlushInstructionCache( ObjectCode *oc )
1432 int n = (oc->fileSize + sizeof( ppcJumpIsland ) * oc->n_islands + 3) / 4;
1433 unsigned long *p = (unsigned long *) oc->image;
1437 __asm__ volatile ( "dcbf 0,%0\n\t"
1445 __asm__ volatile ( "sync\n\t"
1451 /* --------------------------------------------------------------------------
1452 * PEi386 specifics (Win32 targets)
1453 * ------------------------------------------------------------------------*/
1455 /* The information for this linker comes from
1456 Microsoft Portable Executable
1457 and Common Object File Format Specification
1458 revision 5.1 January 1998
1459 which SimonM says comes from the MS Developer Network CDs.
1461 It can be found there (on older CDs), but can also be found
1464 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1466 (this is Rev 6.0 from February 1999).
1468 Things move, so if that fails, try searching for it via
1470 http://www.google.com/search?q=PE+COFF+specification
1472 The ultimate reference for the PE format is the Winnt.h
1473 header file that comes with the Platform SDKs; as always,
1474 implementations will drift wrt their documentation.
1476 A good background article on the PE format is Matt Pietrek's
1477 March 1994 article in Microsoft System Journal (MSJ)
1478 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1479 Win32 Portable Executable File Format." The info in there
1480 has recently been updated in a two part article in
1481 MSDN magazine, issues Feb and March 2002,
1482 "Inside Windows: An In-Depth Look into the Win32 Portable
1483 Executable File Format"
1485 John Levine's book "Linkers and Loaders" contains useful
1490 #if defined(OBJFORMAT_PEi386)
1494 typedef unsigned char UChar;
1495 typedef unsigned short UInt16;
1496 typedef unsigned int UInt32;
1503 UInt16 NumberOfSections;
1504 UInt32 TimeDateStamp;
1505 UInt32 PointerToSymbolTable;
1506 UInt32 NumberOfSymbols;
1507 UInt16 SizeOfOptionalHeader;
1508 UInt16 Characteristics;
1512 #define sizeof_COFF_header 20
1519 UInt32 VirtualAddress;
1520 UInt32 SizeOfRawData;
1521 UInt32 PointerToRawData;
1522 UInt32 PointerToRelocations;
1523 UInt32 PointerToLinenumbers;
1524 UInt16 NumberOfRelocations;
1525 UInt16 NumberOfLineNumbers;
1526 UInt32 Characteristics;
1530 #define sizeof_COFF_section 40
1537 UInt16 SectionNumber;
1540 UChar NumberOfAuxSymbols;
1544 #define sizeof_COFF_symbol 18
1549 UInt32 VirtualAddress;
1550 UInt32 SymbolTableIndex;
1555 #define sizeof_COFF_reloc 10
1558 /* From PE spec doc, section 3.3.2 */
1559 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1560 windows.h -- for the same purpose, but I want to know what I'm
1562 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1563 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1564 #define MYIMAGE_FILE_DLL 0x2000
1565 #define MYIMAGE_FILE_SYSTEM 0x1000
1566 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1567 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1568 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1570 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1571 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1572 #define MYIMAGE_SYM_CLASS_STATIC 3
1573 #define MYIMAGE_SYM_UNDEFINED 0
1575 /* From PE spec doc, section 4.1 */
1576 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1577 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1578 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1580 /* From PE spec doc, section 5.2.1 */
1581 #define MYIMAGE_REL_I386_DIR32 0x0006
1582 #define MYIMAGE_REL_I386_REL32 0x0014
1585 /* We use myindex to calculate array addresses, rather than
1586 simply doing the normal subscript thing. That's because
1587 some of the above structs have sizes which are not
1588 a whole number of words. GCC rounds their sizes up to a
1589 whole number of words, which means that the address calcs
1590 arising from using normal C indexing or pointer arithmetic
1591 are just plain wrong. Sigh.
1594 myindex ( int scale, void* base, int index )
1597 ((UChar*)base) + scale * index;
1602 printName ( UChar* name, UChar* strtab )
1604 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1605 UInt32 strtab_offset = * (UInt32*)(name+4);
1606 debugBelch("%s", strtab + strtab_offset );
1609 for (i = 0; i < 8; i++) {
1610 if (name[i] == 0) break;
1611 debugBelch("%c", name[i] );
1618 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1620 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1621 UInt32 strtab_offset = * (UInt32*)(name+4);
1622 strncpy ( dst, strtab+strtab_offset, dstSize );
1628 if (name[i] == 0) break;
1638 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1641 /* If the string is longer than 8 bytes, look in the
1642 string table for it -- this will be correctly zero terminated.
1644 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1645 UInt32 strtab_offset = * (UInt32*)(name+4);
1646 return ((UChar*)strtab) + strtab_offset;
1648 /* Otherwise, if shorter than 8 bytes, return the original,
1649 which by defn is correctly terminated.
1651 if (name[7]==0) return name;
1652 /* The annoying case: 8 bytes. Copy into a temporary
1653 (which is never freed ...)
1655 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1657 strncpy(newstr,name,8);
1663 /* Just compares the short names (first 8 chars) */
1664 static COFF_section *
1665 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1669 = (COFF_header*)(oc->image);
1670 COFF_section* sectab
1672 ((UChar*)(oc->image))
1673 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1675 for (i = 0; i < hdr->NumberOfSections; i++) {
1678 COFF_section* section_i
1680 myindex ( sizeof_COFF_section, sectab, i );
1681 n1 = (UChar*) &(section_i->Name);
1683 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1684 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1685 n1[6]==n2[6] && n1[7]==n2[7])
1694 zapTrailingAtSign ( UChar* sym )
1696 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1698 if (sym[0] == 0) return;
1700 while (sym[i] != 0) i++;
1703 while (j > 0 && my_isdigit(sym[j])) j--;
1704 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1710 ocVerifyImage_PEi386 ( ObjectCode* oc )
1715 COFF_section* sectab;
1716 COFF_symbol* symtab;
1718 /* debugBelch("\nLOADING %s\n", oc->fileName); */
1719 hdr = (COFF_header*)(oc->image);
1720 sectab = (COFF_section*) (
1721 ((UChar*)(oc->image))
1722 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1724 symtab = (COFF_symbol*) (
1725 ((UChar*)(oc->image))
1726 + hdr->PointerToSymbolTable
1728 strtab = ((UChar*)symtab)
1729 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1731 if (hdr->Machine != 0x14c) {
1732 errorBelch("Not x86 PEi386");
1735 if (hdr->SizeOfOptionalHeader != 0) {
1736 errorBelch("PEi386 with nonempty optional header");
1739 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1740 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1741 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1742 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1743 errorBelch("Not a PEi386 object file");
1746 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1747 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1748 errorBelch("Invalid PEi386 word size or endiannness: %d",
1749 (int)(hdr->Characteristics));
1752 /* If the string table size is way crazy, this might indicate that
1753 there are more than 64k relocations, despite claims to the
1754 contrary. Hence this test. */
1755 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
1757 if ( (*(UInt32*)strtab) > 600000 ) {
1758 /* Note that 600k has no special significance other than being
1759 big enough to handle the almost-2MB-sized lumps that
1760 constitute HSwin32*.o. */
1761 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
1766 /* No further verification after this point; only debug printing. */
1768 IF_DEBUG(linker, i=1);
1769 if (i == 0) return 1;
1771 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1772 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1773 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1776 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1777 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1778 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1779 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1780 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1781 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1782 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1784 /* Print the section table. */
1786 for (i = 0; i < hdr->NumberOfSections; i++) {
1788 COFF_section* sectab_i
1790 myindex ( sizeof_COFF_section, sectab, i );
1797 printName ( sectab_i->Name, strtab );
1807 sectab_i->VirtualSize,
1808 sectab_i->VirtualAddress,
1809 sectab_i->SizeOfRawData,
1810 sectab_i->PointerToRawData,
1811 sectab_i->NumberOfRelocations,
1812 sectab_i->PointerToRelocations,
1813 sectab_i->PointerToRawData
1815 reltab = (COFF_reloc*) (
1816 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1819 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1820 /* If the relocation field (a short) has overflowed, the
1821 * real count can be found in the first reloc entry.
1823 * See Section 4.1 (last para) of the PE spec (rev6.0).
1825 COFF_reloc* rel = (COFF_reloc*)
1826 myindex ( sizeof_COFF_reloc, reltab, 0 );
1827 noRelocs = rel->VirtualAddress;
1830 noRelocs = sectab_i->NumberOfRelocations;
1834 for (; j < noRelocs; j++) {
1836 COFF_reloc* rel = (COFF_reloc*)
1837 myindex ( sizeof_COFF_reloc, reltab, j );
1839 " type 0x%-4x vaddr 0x%-8x name `",
1841 rel->VirtualAddress );
1842 sym = (COFF_symbol*)
1843 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1844 /* Hmm..mysterious looking offset - what's it for? SOF */
1845 printName ( sym->Name, strtab -10 );
1852 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
1853 debugBelch("---START of string table---\n");
1854 for (i = 4; i < *(Int32*)strtab; i++) {
1856 debugBelch("\n"); else
1857 debugBelch("%c", strtab[i] );
1859 debugBelch("--- END of string table---\n");
1864 COFF_symbol* symtab_i;
1865 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1866 symtab_i = (COFF_symbol*)
1867 myindex ( sizeof_COFF_symbol, symtab, i );
1873 printName ( symtab_i->Name, strtab );
1882 (Int32)(symtab_i->SectionNumber),
1883 (UInt32)symtab_i->Type,
1884 (UInt32)symtab_i->StorageClass,
1885 (UInt32)symtab_i->NumberOfAuxSymbols
1887 i += symtab_i->NumberOfAuxSymbols;
1897 ocGetNames_PEi386 ( ObjectCode* oc )
1900 COFF_section* sectab;
1901 COFF_symbol* symtab;
1908 hdr = (COFF_header*)(oc->image);
1909 sectab = (COFF_section*) (
1910 ((UChar*)(oc->image))
1911 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1913 symtab = (COFF_symbol*) (
1914 ((UChar*)(oc->image))
1915 + hdr->PointerToSymbolTable
1917 strtab = ((UChar*)(oc->image))
1918 + hdr->PointerToSymbolTable
1919 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1921 /* Allocate space for any (local, anonymous) .bss sections. */
1923 for (i = 0; i < hdr->NumberOfSections; i++) {
1925 COFF_section* sectab_i
1927 myindex ( sizeof_COFF_section, sectab, i );
1928 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1929 if (sectab_i->VirtualSize == 0) continue;
1930 /* This is a non-empty .bss section. Allocate zeroed space for
1931 it, and set its PointerToRawData field such that oc->image +
1932 PointerToRawData == addr_of_zeroed_space. */
1933 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1934 "ocGetNames_PEi386(anonymous bss)");
1935 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1936 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1937 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
1940 /* Copy section information into the ObjectCode. */
1942 for (i = 0; i < hdr->NumberOfSections; i++) {
1948 = SECTIONKIND_OTHER;
1949 COFF_section* sectab_i
1951 myindex ( sizeof_COFF_section, sectab, i );
1952 IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
1955 /* I'm sure this is the Right Way to do it. However, the
1956 alternative of testing the sectab_i->Name field seems to
1957 work ok with Cygwin.
1959 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1960 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1961 kind = SECTIONKIND_CODE_OR_RODATA;
1964 if (0==strcmp(".text",sectab_i->Name) ||
1965 0==strcmp(".rodata",sectab_i->Name))
1966 kind = SECTIONKIND_CODE_OR_RODATA;
1967 if (0==strcmp(".data",sectab_i->Name) ||
1968 0==strcmp(".bss",sectab_i->Name))
1969 kind = SECTIONKIND_RWDATA;
1971 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1972 sz = sectab_i->SizeOfRawData;
1973 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1975 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1976 end = start + sz - 1;
1978 if (kind == SECTIONKIND_OTHER
1979 /* Ignore sections called which contain stabs debugging
1981 && 0 != strcmp(".stab", sectab_i->Name)
1982 && 0 != strcmp(".stabstr", sectab_i->Name)
1984 errorBelch("Unknown PEi386 section name `%s'", sectab_i->Name);
1988 if (kind != SECTIONKIND_OTHER && end >= start) {
1989 addSection(oc, kind, start, end);
1990 addProddableBlock(oc, start, end - start + 1);
1994 /* Copy exported symbols into the ObjectCode. */
1996 oc->n_symbols = hdr->NumberOfSymbols;
1997 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1998 "ocGetNames_PEi386(oc->symbols)");
1999 /* Call me paranoid; I don't care. */
2000 for (i = 0; i < oc->n_symbols; i++)
2001 oc->symbols[i] = NULL;
2005 COFF_symbol* symtab_i;
2006 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2007 symtab_i = (COFF_symbol*)
2008 myindex ( sizeof_COFF_symbol, symtab, i );
2012 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
2013 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
2014 /* This symbol is global and defined, viz, exported */
2015 /* for MYIMAGE_SYMCLASS_EXTERNAL
2016 && !MYIMAGE_SYM_UNDEFINED,
2017 the address of the symbol is:
2018 address of relevant section + offset in section
2020 COFF_section* sectabent
2021 = (COFF_section*) myindex ( sizeof_COFF_section,
2023 symtab_i->SectionNumber-1 );
2024 addr = ((UChar*)(oc->image))
2025 + (sectabent->PointerToRawData
2029 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
2030 && symtab_i->Value > 0) {
2031 /* This symbol isn't in any section at all, ie, global bss.
2032 Allocate zeroed space for it. */
2033 addr = stgCallocBytes(1, symtab_i->Value,
2034 "ocGetNames_PEi386(non-anonymous bss)");
2035 addSection(oc, SECTIONKIND_RWDATA, addr,
2036 ((UChar*)addr) + symtab_i->Value - 1);
2037 addProddableBlock(oc, addr, symtab_i->Value);
2038 /* debugBelch("BSS section at 0x%x\n", addr); */
2041 if (addr != NULL ) {
2042 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
2043 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
2044 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
2045 ASSERT(i >= 0 && i < oc->n_symbols);
2046 /* cstring_from_COFF_symbol_name always succeeds. */
2047 oc->symbols[i] = sname;
2048 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
2052 "IGNORING symbol %d\n"
2056 printName ( symtab_i->Name, strtab );
2065 (Int32)(symtab_i->SectionNumber),
2066 (UInt32)symtab_i->Type,
2067 (UInt32)symtab_i->StorageClass,
2068 (UInt32)symtab_i->NumberOfAuxSymbols
2073 i += symtab_i->NumberOfAuxSymbols;
2082 ocResolve_PEi386 ( ObjectCode* oc )
2085 COFF_section* sectab;
2086 COFF_symbol* symtab;
2096 /* ToDo: should be variable-sized? But is at least safe in the
2097 sense of buffer-overrun-proof. */
2099 /* debugBelch("resolving for %s\n", oc->fileName); */
2101 hdr = (COFF_header*)(oc->image);
2102 sectab = (COFF_section*) (
2103 ((UChar*)(oc->image))
2104 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2106 symtab = (COFF_symbol*) (
2107 ((UChar*)(oc->image))
2108 + hdr->PointerToSymbolTable
2110 strtab = ((UChar*)(oc->image))
2111 + hdr->PointerToSymbolTable
2112 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2114 for (i = 0; i < hdr->NumberOfSections; i++) {
2115 COFF_section* sectab_i
2117 myindex ( sizeof_COFF_section, sectab, i );
2120 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2123 /* Ignore sections called which contain stabs debugging
2125 if (0 == strcmp(".stab", sectab_i->Name)
2126 || 0 == strcmp(".stabstr", sectab_i->Name))
2129 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2130 /* If the relocation field (a short) has overflowed, the
2131 * real count can be found in the first reloc entry.
2133 * See Section 4.1 (last para) of the PE spec (rev6.0).
2135 * Nov2003 update: the GNU linker still doesn't correctly
2136 * handle the generation of relocatable object files with
2137 * overflown relocations. Hence the output to warn of potential
2140 COFF_reloc* rel = (COFF_reloc*)
2141 myindex ( sizeof_COFF_reloc, reltab, 0 );
2142 noRelocs = rel->VirtualAddress;
2143 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
2147 noRelocs = sectab_i->NumberOfRelocations;
2152 for (; j < noRelocs; j++) {
2154 COFF_reloc* reltab_j
2156 myindex ( sizeof_COFF_reloc, reltab, j );
2158 /* the location to patch */
2160 ((UChar*)(oc->image))
2161 + (sectab_i->PointerToRawData
2162 + reltab_j->VirtualAddress
2163 - sectab_i->VirtualAddress )
2165 /* the existing contents of pP */
2167 /* the symbol to connect to */
2168 sym = (COFF_symbol*)
2169 myindex ( sizeof_COFF_symbol,
2170 symtab, reltab_j->SymbolTableIndex );
2173 "reloc sec %2d num %3d: type 0x%-4x "
2174 "vaddr 0x%-8x name `",
2176 (UInt32)reltab_j->Type,
2177 reltab_j->VirtualAddress );
2178 printName ( sym->Name, strtab );
2179 debugBelch("'\n" ));
2181 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2182 COFF_section* section_sym
2183 = findPEi386SectionCalled ( oc, sym->Name );
2185 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
2188 S = ((UInt32)(oc->image))
2189 + (section_sym->PointerToRawData
2192 copyName ( sym->Name, strtab, symbol, 1000-1 );
2193 (void*)S = lookupLocalSymbol( oc, symbol );
2194 if ((void*)S != NULL) goto foundit;
2195 (void*)S = lookupSymbol( symbol );
2196 if ((void*)S != NULL) goto foundit;
2197 zapTrailingAtSign ( symbol );
2198 (void*)S = lookupLocalSymbol( oc, symbol );
2199 if ((void*)S != NULL) goto foundit;
2200 (void*)S = lookupSymbol( symbol );
2201 if ((void*)S != NULL) goto foundit;
2202 /* Newline first because the interactive linker has printed "linking..." */
2203 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2207 checkProddableBlock(oc, pP);
2208 switch (reltab_j->Type) {
2209 case MYIMAGE_REL_I386_DIR32:
2212 case MYIMAGE_REL_I386_REL32:
2213 /* Tricky. We have to insert a displacement at
2214 pP which, when added to the PC for the _next_
2215 insn, gives the address of the target (S).
2216 Problem is to know the address of the next insn
2217 when we only know pP. We assume that this
2218 literal field is always the last in the insn,
2219 so that the address of the next insn is pP+4
2220 -- hence the constant 4.
2221 Also I don't know if A should be added, but so
2222 far it has always been zero.
2225 *pP = S - ((UInt32)pP) - 4;
2228 debugBelch("%s: unhandled PEi386 relocation type %d",
2229 oc->fileName, reltab_j->Type);
2236 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
2240 #endif /* defined(OBJFORMAT_PEi386) */
2243 /* --------------------------------------------------------------------------
2245 * ------------------------------------------------------------------------*/
2247 #if defined(OBJFORMAT_ELF)
2252 #if defined(sparc_HOST_ARCH)
2253 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2254 #elif defined(i386_HOST_ARCH)
2255 # define ELF_TARGET_386 /* Used inside <elf.h> */
2256 #elif defined(x86_64_HOST_ARCH)
2257 # define ELF_TARGET_X64_64
2259 #elif defined (ia64_HOST_ARCH)
2260 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2262 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2263 # define ELF_NEED_GOT /* needs Global Offset Table */
2264 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2267 #if !defined(openbsd_HOST_OS)
2270 /* openbsd elf has things in different places, with diff names */
2271 #include <elf_abi.h>
2272 #include <machine/reloc.h>
2273 #define R_386_32 RELOC_32
2274 #define R_386_PC32 RELOC_PC32
2278 * Define a set of types which can be used for both ELF32 and ELF64
2282 #define ELFCLASS ELFCLASS64
2283 #define Elf_Addr Elf64_Addr
2284 #define Elf_Word Elf64_Word
2285 #define Elf_Sword Elf64_Sword
2286 #define Elf_Ehdr Elf64_Ehdr
2287 #define Elf_Phdr Elf64_Phdr
2288 #define Elf_Shdr Elf64_Shdr
2289 #define Elf_Sym Elf64_Sym
2290 #define Elf_Rel Elf64_Rel
2291 #define Elf_Rela Elf64_Rela
2292 #define ELF_ST_TYPE ELF64_ST_TYPE
2293 #define ELF_ST_BIND ELF64_ST_BIND
2294 #define ELF_R_TYPE ELF64_R_TYPE
2295 #define ELF_R_SYM ELF64_R_SYM
2297 #define ELFCLASS ELFCLASS32
2298 #define Elf_Addr Elf32_Addr
2299 #define Elf_Word Elf32_Word
2300 #define Elf_Sword Elf32_Sword
2301 #define Elf_Ehdr Elf32_Ehdr
2302 #define Elf_Phdr Elf32_Phdr
2303 #define Elf_Shdr Elf32_Shdr
2304 #define Elf_Sym Elf32_Sym
2305 #define Elf_Rel Elf32_Rel
2306 #define Elf_Rela Elf32_Rela
2308 #define ELF_ST_TYPE ELF32_ST_TYPE
2311 #define ELF_ST_BIND ELF32_ST_BIND
2314 #define ELF_R_TYPE ELF32_R_TYPE
2317 #define ELF_R_SYM ELF32_R_SYM
2323 * Functions to allocate entries in dynamic sections. Currently we simply
2324 * preallocate a large number, and we don't check if a entry for the given
2325 * target already exists (a linear search is too slow). Ideally these
2326 * entries would be associated with symbols.
2329 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2330 #define GOT_SIZE 0x20000
2331 #define FUNCTION_TABLE_SIZE 0x10000
2332 #define PLT_SIZE 0x08000
2335 static Elf_Addr got[GOT_SIZE];
2336 static unsigned int gotIndex;
2337 static Elf_Addr gp_val = (Elf_Addr)got;
2340 allocateGOTEntry(Elf_Addr target)
2344 if (gotIndex >= GOT_SIZE)
2345 barf("Global offset table overflow");
2347 entry = &got[gotIndex++];
2349 return (Elf_Addr)entry;
2353 #ifdef ELF_FUNCTION_DESC
2359 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2360 static unsigned int functionTableIndex;
2363 allocateFunctionDesc(Elf_Addr target)
2365 FunctionDesc *entry;
2367 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2368 barf("Function table overflow");
2370 entry = &functionTable[functionTableIndex++];
2372 entry->gp = (Elf_Addr)gp_val;
2373 return (Elf_Addr)entry;
2377 copyFunctionDesc(Elf_Addr target)
2379 FunctionDesc *olddesc = (FunctionDesc *)target;
2380 FunctionDesc *newdesc;
2382 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2383 newdesc->gp = olddesc->gp;
2384 return (Elf_Addr)newdesc;
2389 #ifdef ia64_HOST_ARCH
2390 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2391 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2393 static unsigned char plt_code[] =
2395 /* taken from binutils bfd/elfxx-ia64.c */
2396 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2397 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2398 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2399 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2400 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2401 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2404 /* If we can't get to the function descriptor via gp, take a local copy of it */
2405 #define PLT_RELOC(code, target) { \
2406 Elf64_Sxword rel_value = target - gp_val; \
2407 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2408 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2410 ia64_reloc_gprel22((Elf_Addr)code, target); \
2415 unsigned char code[sizeof(plt_code)];
2419 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2421 PLTEntry *plt = (PLTEntry *)oc->plt;
2424 if (oc->pltIndex >= PLT_SIZE)
2425 barf("Procedure table overflow");
2427 entry = &plt[oc->pltIndex++];
2428 memcpy(entry->code, plt_code, sizeof(entry->code));
2429 PLT_RELOC(entry->code, target);
2430 return (Elf_Addr)entry;
2436 return (PLT_SIZE * sizeof(PLTEntry));
2442 * Generic ELF functions
2446 findElfSection ( void* objImage, Elf_Word sh_type )
2448 char* ehdrC = (char*)objImage;
2449 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2450 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2451 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2455 for (i = 0; i < ehdr->e_shnum; i++) {
2456 if (shdr[i].sh_type == sh_type
2457 /* Ignore the section header's string table. */
2458 && i != ehdr->e_shstrndx
2459 /* Ignore string tables named .stabstr, as they contain
2461 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2463 ptr = ehdrC + shdr[i].sh_offset;
2470 #if defined(ia64_HOST_ARCH)
2472 findElfSegment ( void* objImage, Elf_Addr vaddr )
2474 char* ehdrC = (char*)objImage;
2475 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2476 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2477 Elf_Addr segaddr = 0;
2480 for (i = 0; i < ehdr->e_phnum; i++) {
2481 segaddr = phdr[i].p_vaddr;
2482 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2490 ocVerifyImage_ELF ( ObjectCode* oc )
2494 int i, j, nent, nstrtab, nsymtabs;
2498 char* ehdrC = (char*)(oc->image);
2499 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2501 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2502 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2503 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2504 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2505 errorBelch("%s: not an ELF object", oc->fileName);
2509 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2510 errorBelch("%s: unsupported ELF format", oc->fileName);
2514 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2515 IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
2517 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2518 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
2520 errorBelch("%s: unknown endiannness", oc->fileName);
2524 if (ehdr->e_type != ET_REL) {
2525 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
2528 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
2530 IF_DEBUG(linker,debugBelch( "Architecture is " ));
2531 switch (ehdr->e_machine) {
2532 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
2533 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
2535 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
2537 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
2539 case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
2541 default: IF_DEBUG(linker,debugBelch( "unknown" ));
2542 errorBelch("%s: unknown architecture", oc->fileName);
2546 IF_DEBUG(linker,debugBelch(
2547 "\nSection header table: start %d, n_entries %d, ent_size %d\n",
2548 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2550 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2552 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2554 if (ehdr->e_shstrndx == SHN_UNDEF) {
2555 errorBelch("%s: no section header string table", oc->fileName);
2558 IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
2560 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2563 for (i = 0; i < ehdr->e_shnum; i++) {
2564 IF_DEBUG(linker,debugBelch("%2d: ", i ));
2565 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
2566 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
2567 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
2568 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
2569 ehdrC + shdr[i].sh_offset,
2570 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2572 if (shdr[i].sh_type == SHT_REL) {
2573 IF_DEBUG(linker,debugBelch("Rel " ));
2574 } else if (shdr[i].sh_type == SHT_RELA) {
2575 IF_DEBUG(linker,debugBelch("RelA " ));
2577 IF_DEBUG(linker,debugBelch(" "));
2580 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
2584 IF_DEBUG(linker,debugBelch( "\nString tables" ));
2587 for (i = 0; i < ehdr->e_shnum; i++) {
2588 if (shdr[i].sh_type == SHT_STRTAB
2589 /* Ignore the section header's string table. */
2590 && i != ehdr->e_shstrndx
2591 /* Ignore string tables named .stabstr, as they contain
2593 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2595 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
2596 strtab = ehdrC + shdr[i].sh_offset;
2601 errorBelch("%s: no string tables, or too many", oc->fileName);
2606 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
2607 for (i = 0; i < ehdr->e_shnum; i++) {
2608 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2609 IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
2611 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2612 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2613 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%d rem)\n",
2615 shdr[i].sh_size % sizeof(Elf_Sym)
2617 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2618 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
2621 for (j = 0; j < nent; j++) {
2622 IF_DEBUG(linker,debugBelch(" %2d ", j ));
2623 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
2624 (int)stab[j].st_shndx,
2625 (int)stab[j].st_size,
2626 (char*)stab[j].st_value ));
2628 IF_DEBUG(linker,debugBelch("type=" ));
2629 switch (ELF_ST_TYPE(stab[j].st_info)) {
2630 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
2631 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
2632 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
2633 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
2634 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
2635 default: IF_DEBUG(linker,debugBelch("? " )); break;
2637 IF_DEBUG(linker,debugBelch(" " ));
2639 IF_DEBUG(linker,debugBelch("bind=" ));
2640 switch (ELF_ST_BIND(stab[j].st_info)) {
2641 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
2642 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
2643 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
2644 default: IF_DEBUG(linker,debugBelch("? " )); break;
2646 IF_DEBUG(linker,debugBelch(" " ));
2648 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
2652 if (nsymtabs == 0) {
2653 errorBelch("%s: didn't find any symbol tables", oc->fileName);
2660 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
2664 if (hdr->sh_type == SHT_PROGBITS
2665 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
2666 /* .text-style section */
2667 return SECTIONKIND_CODE_OR_RODATA;
2670 if (hdr->sh_type == SHT_PROGBITS
2671 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2672 /* .data-style section */
2673 return SECTIONKIND_RWDATA;
2676 if (hdr->sh_type == SHT_PROGBITS
2677 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
2678 /* .rodata-style section */
2679 return SECTIONKIND_CODE_OR_RODATA;
2682 if (hdr->sh_type == SHT_NOBITS
2683 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2684 /* .bss-style section */
2686 return SECTIONKIND_RWDATA;
2689 return SECTIONKIND_OTHER;
2694 ocGetNames_ELF ( ObjectCode* oc )
2699 char* ehdrC = (char*)(oc->image);
2700 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2701 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2702 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2704 ASSERT(symhash != NULL);
2707 errorBelch("%s: no strtab", oc->fileName);
2712 for (i = 0; i < ehdr->e_shnum; i++) {
2713 /* Figure out what kind of section it is. Logic derived from
2714 Figure 1.14 ("Special Sections") of the ELF document
2715 ("Portable Formats Specification, Version 1.1"). */
2717 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
2719 if (is_bss && shdr[i].sh_size > 0) {
2720 /* This is a non-empty .bss section. Allocate zeroed space for
2721 it, and set its .sh_offset field such that
2722 ehdrC + .sh_offset == addr_of_zeroed_space. */
2723 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2724 "ocGetNames_ELF(BSS)");
2725 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2727 debugBelch("BSS section at 0x%x, size %d\n",
2728 zspace, shdr[i].sh_size);
2732 /* fill in the section info */
2733 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2734 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2735 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2736 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2739 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2741 /* copy stuff into this module's object symbol table */
2742 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2743 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2745 oc->n_symbols = nent;
2746 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2747 "ocGetNames_ELF(oc->symbols)");
2749 for (j = 0; j < nent; j++) {
2751 char isLocal = FALSE; /* avoids uninit-var warning */
2753 char* nm = strtab + stab[j].st_name;
2754 int secno = stab[j].st_shndx;
2756 /* Figure out if we want to add it; if so, set ad to its
2757 address. Otherwise leave ad == NULL. */
2759 if (secno == SHN_COMMON) {
2761 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2763 debugBelch("COMMON symbol, size %d name %s\n",
2764 stab[j].st_size, nm);
2766 /* Pointless to do addProddableBlock() for this area,
2767 since the linker should never poke around in it. */
2770 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2771 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2773 /* and not an undefined symbol */
2774 && stab[j].st_shndx != SHN_UNDEF
2775 /* and not in a "special section" */
2776 && stab[j].st_shndx < SHN_LORESERVE
2778 /* and it's a not a section or string table or anything silly */
2779 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2780 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2781 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2784 /* Section 0 is the undefined section, hence > and not >=. */
2785 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2787 if (shdr[secno].sh_type == SHT_NOBITS) {
2788 debugBelch(" BSS symbol, size %d off %d name %s\n",
2789 stab[j].st_size, stab[j].st_value, nm);
2792 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2793 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2796 #ifdef ELF_FUNCTION_DESC
2797 /* dlsym() and the initialisation table both give us function
2798 * descriptors, so to be consistent we store function descriptors
2799 * in the symbol table */
2800 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2801 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2803 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s",
2804 ad, oc->fileName, nm ));
2809 /* And the decision is ... */
2813 oc->symbols[j] = nm;
2816 /* Ignore entirely. */
2818 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2822 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
2823 strtab + stab[j].st_name ));
2826 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2827 (int)ELF_ST_BIND(stab[j].st_info),
2828 (int)ELF_ST_TYPE(stab[j].st_info),
2829 (int)stab[j].st_shndx,
2830 strtab + stab[j].st_name
2833 oc->symbols[j] = NULL;
2842 /* Do ELF relocations which lack an explicit addend. All x86-linux
2843 relocations appear to be of this form. */
2845 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2846 Elf_Shdr* shdr, int shnum,
2847 Elf_Sym* stab, char* strtab )
2852 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2853 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2854 int target_shndx = shdr[shnum].sh_info;
2855 int symtab_shndx = shdr[shnum].sh_link;
2857 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2858 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2859 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
2860 target_shndx, symtab_shndx ));
2862 /* Skip sections that we're not interested in. */
2865 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
2866 if (kind == SECTIONKIND_OTHER) {
2867 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
2872 for (j = 0; j < nent; j++) {
2873 Elf_Addr offset = rtab[j].r_offset;
2874 Elf_Addr info = rtab[j].r_info;
2876 Elf_Addr P = ((Elf_Addr)targ) + offset;
2877 Elf_Word* pP = (Elf_Word*)P;
2883 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
2884 j, (void*)offset, (void*)info ));
2886 IF_DEBUG(linker,debugBelch( " ZERO" ));
2889 Elf_Sym sym = stab[ELF_R_SYM(info)];
2890 /* First see if it is a local symbol. */
2891 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2892 /* Yes, so we can get the address directly from the ELF symbol
2894 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2896 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2897 + stab[ELF_R_SYM(info)].st_value);
2900 /* No, so look up the name in our global table. */
2901 symbol = strtab + sym.st_name;
2902 S_tmp = lookupSymbol( symbol );
2903 S = (Elf_Addr)S_tmp;
2906 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
2909 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
2912 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
2913 (void*)P, (void*)S, (void*)A ));
2914 checkProddableBlock ( oc, pP );
2918 switch (ELF_R_TYPE(info)) {
2919 # ifdef i386_HOST_ARCH
2920 case R_386_32: *pP = value; break;
2921 case R_386_PC32: *pP = value - P; break;
2924 errorBelch("%s: unhandled ELF relocation(Rel) type %d\n",
2925 oc->fileName, ELF_R_TYPE(info));
2933 /* Do ELF relocations for which explicit addends are supplied.
2934 sparc-solaris relocations appear to be of this form. */
2936 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2937 Elf_Shdr* shdr, int shnum,
2938 Elf_Sym* stab, char* strtab )
2943 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2944 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2945 int target_shndx = shdr[shnum].sh_info;
2946 int symtab_shndx = shdr[shnum].sh_link;
2948 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2949 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2950 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
2951 target_shndx, symtab_shndx ));
2953 for (j = 0; j < nent; j++) {
2954 #if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
2955 /* This #ifdef only serves to avoid unused-var warnings. */
2956 Elf_Addr offset = rtab[j].r_offset;
2957 Elf_Addr P = targ + offset;
2959 Elf_Addr info = rtab[j].r_info;
2960 Elf_Addr A = rtab[j].r_addend;
2964 # if defined(sparc_HOST_ARCH)
2965 Elf_Word* pP = (Elf_Word*)P;
2967 # elif defined(ia64_HOST_ARCH)
2968 Elf64_Xword *pP = (Elf64_Xword *)P;
2970 # elif defined(powerpc_HOST_ARCH)
2974 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
2975 j, (void*)offset, (void*)info,
2978 IF_DEBUG(linker,debugBelch( " ZERO" ));
2981 Elf_Sym sym = stab[ELF_R_SYM(info)];
2982 /* First see if it is a local symbol. */
2983 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2984 /* Yes, so we can get the address directly from the ELF symbol
2986 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2988 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2989 + stab[ELF_R_SYM(info)].st_value);
2990 #ifdef ELF_FUNCTION_DESC
2991 /* Make a function descriptor for this function */
2992 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2993 S = allocateFunctionDesc(S + A);
2998 /* No, so look up the name in our global table. */
2999 symbol = strtab + sym.st_name;
3000 S_tmp = lookupSymbol( symbol );
3001 S = (Elf_Addr)S_tmp;
3003 #ifdef ELF_FUNCTION_DESC
3004 /* If a function, already a function descriptor - we would
3005 have to copy it to add an offset. */
3006 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
3007 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
3011 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3014 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
3017 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
3018 (void*)P, (void*)S, (void*)A ));
3019 /* checkProddableBlock ( oc, (void*)P ); */
3023 switch (ELF_R_TYPE(info)) {
3024 # if defined(sparc_HOST_ARCH)
3025 case R_SPARC_WDISP30:
3026 w1 = *pP & 0xC0000000;
3027 w2 = (Elf_Word)((value - P) >> 2);
3028 ASSERT((w2 & 0xC0000000) == 0);
3033 w1 = *pP & 0xFFC00000;
3034 w2 = (Elf_Word)(value >> 10);
3035 ASSERT((w2 & 0xFFC00000) == 0);
3041 w2 = (Elf_Word)(value & 0x3FF);
3042 ASSERT((w2 & ~0x3FF) == 0);
3046 /* According to the Sun documentation:
3048 This relocation type resembles R_SPARC_32, except it refers to an
3049 unaligned word. That is, the word to be relocated must be treated
3050 as four separate bytes with arbitrary alignment, not as a word
3051 aligned according to the architecture requirements.
3053 (JRS: which means that freeloading on the R_SPARC_32 case
3054 is probably wrong, but hey ...)
3058 w2 = (Elf_Word)value;
3061 # elif defined(ia64_HOST_ARCH)
3062 case R_IA64_DIR64LSB:
3063 case R_IA64_FPTR64LSB:
3066 case R_IA64_PCREL64LSB:
3069 case R_IA64_SEGREL64LSB:
3070 addr = findElfSegment(ehdrC, value);
3073 case R_IA64_GPREL22:
3074 ia64_reloc_gprel22(P, value);
3076 case R_IA64_LTOFF22:
3077 case R_IA64_LTOFF22X:
3078 case R_IA64_LTOFF_FPTR22:
3079 addr = allocateGOTEntry(value);
3080 ia64_reloc_gprel22(P, addr);
3082 case R_IA64_PCREL21B:
3083 ia64_reloc_pcrel21(P, S, oc);
3086 /* This goes with R_IA64_LTOFF22X and points to the load to
3087 * convert into a move. We don't implement relaxation. */
3089 # elif defined(powerpc_HOST_ARCH)
3090 case R_PPC_ADDR16_LO:
3091 *(Elf32_Half*) P = value;
3094 case R_PPC_ADDR16_HI:
3095 *(Elf32_Half*) P = value >> 16;
3098 case R_PPC_ADDR16_HA:
3099 *(Elf32_Half*) P = (value + 0x8000) >> 16;
3103 *(Elf32_Word *) P = value;
3107 *(Elf32_Word *) P = value - P;
3113 if( delta << 6 >> 6 != delta )
3115 value = makeJumpIsland( oc, ELF_R_SYM(info), value );
3118 if( value == 0 || delta << 6 >> 6 != delta )
3120 barf( "Unable to make ppcJumpIsland for #%d",
3126 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3127 | (delta & 0x3fffffc);
3133 *(Elf64_Xword *)P = value;
3137 *(Elf64_Word *)P = (Elf64_Word) (value - P);
3141 *(Elf64_Word *)P = (Elf64_Word)value;
3145 *(Elf64_Sword *)P = (Elf64_Sword)value;
3150 errorBelch("%s: unhandled ELF relocation(RelA) type %d\n",
3151 oc->fileName, ELF_R_TYPE(info));
3160 ocResolve_ELF ( ObjectCode* oc )
3164 Elf_Sym* stab = NULL;
3165 char* ehdrC = (char*)(oc->image);
3166 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
3167 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3169 /* first find "the" symbol table */
3170 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
3172 /* also go find the string table */
3173 strtab = findElfSection ( ehdrC, SHT_STRTAB );
3175 if (stab == NULL || strtab == NULL) {
3176 errorBelch("%s: can't find string or symbol table", oc->fileName);
3180 /* Process the relocation sections. */
3181 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
3182 if (shdr[shnum].sh_type == SHT_REL) {
3183 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
3184 shnum, stab, strtab );
3188 if (shdr[shnum].sh_type == SHT_RELA) {
3189 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
3190 shnum, stab, strtab );
3195 /* Free the local symbol table; we won't need it again. */
3196 freeHashTable(oc->lochash, NULL);
3199 #if defined(powerpc_HOST_ARCH)
3200 ocFlushInstructionCache( oc );
3208 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
3209 * at the front. The following utility functions pack and unpack instructions, and
3210 * take care of the most common relocations.
3213 #ifdef ia64_HOST_ARCH
3216 ia64_extract_instruction(Elf64_Xword *target)
3219 int slot = (Elf_Addr)target & 3;
3220 (Elf_Addr)target &= ~3;
3228 return ((w1 >> 5) & 0x1ffffffffff);
3230 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
3234 barf("ia64_extract_instruction: invalid slot %p", target);
3239 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
3241 int slot = (Elf_Addr)target & 3;
3242 (Elf_Addr)target &= ~3;
3247 *target |= value << 5;
3250 *target |= value << 46;
3251 *(target+1) |= value >> 18;
3254 *(target+1) |= value << 23;
3260 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3262 Elf64_Xword instruction;
3263 Elf64_Sxword rel_value;
3265 rel_value = value - gp_val;
3266 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3267 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3269 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3270 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3271 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3272 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3273 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3274 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3278 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3280 Elf64_Xword instruction;
3281 Elf64_Sxword rel_value;
3284 entry = allocatePLTEntry(value, oc);
3286 rel_value = (entry >> 4) - (target >> 4);
3287 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3288 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3290 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3291 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3292 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3293 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3299 * PowerPC ELF specifics
3302 #ifdef powerpc_HOST_ARCH
3304 static int ocAllocateJumpIslands_ELF( ObjectCode *oc )
3310 ehdr = (Elf_Ehdr *) oc->image;
3311 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
3313 for( i = 0; i < ehdr->e_shnum; i++ )
3314 if( shdr[i].sh_type == SHT_SYMTAB )
3317 if( i == ehdr->e_shnum )
3319 errorBelch( "This ELF file contains no symtab" );
3323 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
3325 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
3326 shdr[i].sh_entsize, sizeof( Elf_Sym ) );
3331 return ocAllocateJumpIslands( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
3334 #endif /* powerpc */
3338 /* --------------------------------------------------------------------------
3340 * ------------------------------------------------------------------------*/
3342 #if defined(OBJFORMAT_MACHO)
3345 Support for MachO linking on Darwin/MacOS X on PowerPC chips
3346 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3348 I hereby formally apologize for the hackish nature of this code.
3349 Things that need to be done:
3350 *) implement ocVerifyImage_MachO
3351 *) add still more sanity checks.
3354 static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
3356 struct mach_header *header = (struct mach_header *) oc->image;
3357 struct load_command *lc = (struct load_command *) (header + 1);
3360 for( i = 0; i < header->ncmds; i++ )
3362 if( lc->cmd == LC_SYMTAB )
3364 // Find out the first and last undefined external
3365 // symbol, so we don't have to allocate too many
3367 struct symtab_command *symLC = (struct symtab_command *) lc;
3368 unsigned min = symLC->nsyms, max = 0;
3369 struct nlist *nlist =
3370 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
3372 for(i=0;i<symLC->nsyms;i++)
3374 if(nlist[i].n_type & N_STAB)
3376 else if(nlist[i].n_type & N_EXT)
3378 if((nlist[i].n_type & N_TYPE) == N_UNDF
3379 && (nlist[i].n_value == 0))
3389 return ocAllocateJumpIslands(oc, max - min + 1, min);
3394 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3396 return ocAllocateJumpIslands(oc,0,0);
3399 static int ocVerifyImage_MachO(ObjectCode* oc STG_UNUSED)
3401 // FIXME: do some verifying here
3405 static int resolveImports(
3408 struct symtab_command *symLC,
3409 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3410 unsigned long *indirectSyms,
3411 struct nlist *nlist)
3415 for(i=0;i*4<sect->size;i++)
3417 // according to otool, reserved1 contains the first index into the indirect symbol table
3418 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3419 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3422 if((symbol->n_type & N_TYPE) == N_UNDF
3423 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3424 addr = (void*) (symbol->n_value);
3425 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3428 addr = lookupSymbol(nm);
3431 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3435 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3436 ((void**)(image + sect->offset))[i] = addr;
3442 static unsigned long relocateAddress(
3445 struct section* sections,
3446 unsigned long address)
3449 for(i = 0; i < nSections; i++)
3451 if(sections[i].addr <= address
3452 && address < sections[i].addr + sections[i].size)
3454 return (unsigned long)oc->image
3455 + sections[i].offset + address - sections[i].addr;
3458 barf("Invalid Mach-O file:"
3459 "Address out of bounds while relocating object file");
3463 static int relocateSection(
3466 struct symtab_command *symLC, struct nlist *nlist,
3467 int nSections, struct section* sections, struct section *sect)
3469 struct relocation_info *relocs;
3472 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3474 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3478 relocs = (struct relocation_info*) (image + sect->reloff);
3482 if(relocs[i].r_address & R_SCATTERED)
3484 struct scattered_relocation_info *scat =
3485 (struct scattered_relocation_info*) &relocs[i];
3489 if(scat->r_length == 2)
3491 unsigned long word = 0;
3492 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
3493 checkProddableBlock(oc,wordPtr);
3495 // Step 1: Figure out what the relocated value should be
3496 if(scat->r_type == GENERIC_RELOC_VANILLA)
3498 word = *wordPtr + (unsigned long) relocateAddress(
3505 else if(scat->r_type == PPC_RELOC_SECTDIFF
3506 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
3507 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
3508 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3510 struct scattered_relocation_info *pair =
3511 (struct scattered_relocation_info*) &relocs[i+1];
3513 if(!pair->r_scattered || pair->r_type != PPC_RELOC_PAIR)
3514 barf("Invalid Mach-O file: "
3515 "PPC_RELOC_*_SECTDIFF not followed by PPC_RELOC_PAIR");
3517 word = (unsigned long)
3518 (relocateAddress(oc, nSections, sections, scat->r_value)
3519 - relocateAddress(oc, nSections, sections, pair->r_value));
3522 else if(scat->r_type == PPC_RELOC_HI16
3523 || scat->r_type == PPC_RELOC_LO16
3524 || scat->r_type == PPC_RELOC_HA16
3525 || scat->r_type == PPC_RELOC_LO14)
3526 { // these are generated by label+offset things
3527 struct relocation_info *pair = &relocs[i+1];
3528 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
3529 barf("Invalid Mach-O file: "
3530 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
3532 if(scat->r_type == PPC_RELOC_LO16)
3534 word = ((unsigned short*) wordPtr)[1];
3535 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3537 else if(scat->r_type == PPC_RELOC_LO14)
3539 barf("Unsupported Relocation: PPC_RELOC_LO14");
3540 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
3541 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3543 else if(scat->r_type == PPC_RELOC_HI16)
3545 word = ((unsigned short*) wordPtr)[1] << 16;
3546 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3548 else if(scat->r_type == PPC_RELOC_HA16)
3550 word = ((unsigned short*) wordPtr)[1] << 16;
3551 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3555 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
3561 continue; // ignore the others
3563 if(scat->r_type == GENERIC_RELOC_VANILLA
3564 || scat->r_type == PPC_RELOC_SECTDIFF)
3568 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
3570 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3572 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
3574 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3576 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
3578 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3579 + ((word & (1<<15)) ? 1 : 0);
3584 continue; // FIXME: I hope it's OK to ignore all the others.
3588 struct relocation_info *reloc = &relocs[i];
3589 if(reloc->r_pcrel && !reloc->r_extern)
3592 if(reloc->r_length == 2)
3594 unsigned long word = 0;
3595 unsigned long jumpIsland = 0;
3596 long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
3597 // to avoid warning and to catch
3600 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3601 checkProddableBlock(oc,wordPtr);
3603 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3607 else if(reloc->r_type == PPC_RELOC_LO16)
3609 word = ((unsigned short*) wordPtr)[1];
3610 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3612 else if(reloc->r_type == PPC_RELOC_HI16)
3614 word = ((unsigned short*) wordPtr)[1] << 16;
3615 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3617 else if(reloc->r_type == PPC_RELOC_HA16)
3619 word = ((unsigned short*) wordPtr)[1] << 16;
3620 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3622 else if(reloc->r_type == PPC_RELOC_BR24)
3625 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
3629 if(!reloc->r_extern)
3632 sections[reloc->r_symbolnum-1].offset
3633 - sections[reloc->r_symbolnum-1].addr
3640 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3641 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3642 void *symbolAddress = lookupSymbol(nm);
3645 errorBelch("\nunknown symbol `%s'", nm);
3651 // In the .o file, this should be a relative jump to NULL
3652 // and we'll change it to a jump to a relative jump to the symbol
3653 ASSERT(-word == reloc->r_address);
3654 word = (unsigned long) symbolAddress;
3655 jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,word);
3656 word -= ((long)image) + sect->offset + reloc->r_address;
3659 offsetToJumpIsland = jumpIsland
3660 - (((long)image) + sect->offset + reloc->r_address);
3665 word += (unsigned long) symbolAddress;
3669 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3674 else if(reloc->r_type == PPC_RELOC_LO16)
3676 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3679 else if(reloc->r_type == PPC_RELOC_HI16)
3681 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3684 else if(reloc->r_type == PPC_RELOC_HA16)
3686 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3687 + ((word & (1<<15)) ? 1 : 0);
3690 else if(reloc->r_type == PPC_RELOC_BR24)
3692 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3694 // The branch offset is too large.
3695 // Therefore, we try to use a jump island.
3698 barf("unconditional relative branch out of range: "
3699 "no jump island available");
3702 word = offsetToJumpIsland;
3703 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3704 barf("unconditional relative branch out of range: "
3705 "jump island out of range");
3707 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3711 barf("\nunknown relocation %d",reloc->r_type);
3718 static int ocGetNames_MachO(ObjectCode* oc)
3720 char *image = (char*) oc->image;
3721 struct mach_header *header = (struct mach_header*) image;
3722 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3723 unsigned i,curSymbol = 0;
3724 struct segment_command *segLC = NULL;
3725 struct section *sections;
3726 struct symtab_command *symLC = NULL;
3727 struct nlist *nlist;
3728 unsigned long commonSize = 0;
3729 char *commonStorage = NULL;
3730 unsigned long commonCounter;
3732 for(i=0;i<header->ncmds;i++)
3734 if(lc->cmd == LC_SEGMENT)
3735 segLC = (struct segment_command*) lc;
3736 else if(lc->cmd == LC_SYMTAB)
3737 symLC = (struct symtab_command*) lc;
3738 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3741 sections = (struct section*) (segLC+1);
3742 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
3745 for(i=0;i<segLC->nsects;i++)
3747 if(sections[i].size == 0)
3750 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
3752 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
3753 "ocGetNames_MachO(common symbols)");
3754 sections[i].offset = zeroFillArea - image;
3757 if(!strcmp(sections[i].sectname,"__text"))
3758 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3759 (void*) (image + sections[i].offset),
3760 (void*) (image + sections[i].offset + sections[i].size));
3761 else if(!strcmp(sections[i].sectname,"__const"))
3762 addSection(oc, SECTIONKIND_RWDATA,
3763 (void*) (image + sections[i].offset),
3764 (void*) (image + sections[i].offset + sections[i].size));
3765 else if(!strcmp(sections[i].sectname,"__data"))
3766 addSection(oc, SECTIONKIND_RWDATA,
3767 (void*) (image + sections[i].offset),
3768 (void*) (image + sections[i].offset + sections[i].size));
3769 else if(!strcmp(sections[i].sectname,"__bss")
3770 || !strcmp(sections[i].sectname,"__common"))
3771 addSection(oc, SECTIONKIND_RWDATA,
3772 (void*) (image + sections[i].offset),
3773 (void*) (image + sections[i].offset + sections[i].size));
3775 addProddableBlock(oc, (void*) (image + sections[i].offset),
3779 // count external symbols defined here
3783 for(i=0;i<symLC->nsyms;i++)
3785 if(nlist[i].n_type & N_STAB)
3787 else if(nlist[i].n_type & N_EXT)
3789 if((nlist[i].n_type & N_TYPE) == N_UNDF
3790 && (nlist[i].n_value != 0))
3792 commonSize += nlist[i].n_value;
3795 else if((nlist[i].n_type & N_TYPE) == N_SECT)
3800 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3801 "ocGetNames_MachO(oc->symbols)");
3805 for(i=0;i<symLC->nsyms;i++)
3807 if(nlist[i].n_type & N_STAB)
3809 else if((nlist[i].n_type & N_TYPE) == N_SECT)
3811 if(nlist[i].n_type & N_EXT)
3813 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3814 ghciInsertStrHashTable(oc->fileName, symhash, nm,
3816 + sections[nlist[i].n_sect-1].offset
3817 - sections[nlist[i].n_sect-1].addr
3818 + nlist[i].n_value);
3819 oc->symbols[curSymbol++] = nm;
3823 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3824 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm,
3826 + sections[nlist[i].n_sect-1].offset
3827 - sections[nlist[i].n_sect-1].addr
3828 + nlist[i].n_value);
3834 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3835 commonCounter = (unsigned long)commonStorage;
3838 for(i=0;i<symLC->nsyms;i++)
3840 if((nlist[i].n_type & N_TYPE) == N_UNDF
3841 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3843 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3844 unsigned long sz = nlist[i].n_value;
3846 nlist[i].n_value = commonCounter;
3848 ghciInsertStrHashTable(oc->fileName, symhash, nm,
3849 (void*)commonCounter);
3850 oc->symbols[curSymbol++] = nm;
3852 commonCounter += sz;
3859 static int ocResolve_MachO(ObjectCode* oc)
3861 char *image = (char*) oc->image;
3862 struct mach_header *header = (struct mach_header*) image;
3863 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3865 struct segment_command *segLC = NULL;
3866 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3867 struct symtab_command *symLC = NULL;
3868 struct dysymtab_command *dsymLC = NULL;
3869 struct nlist *nlist;
3871 for(i=0;i<header->ncmds;i++)
3873 if(lc->cmd == LC_SEGMENT)
3874 segLC = (struct segment_command*) lc;
3875 else if(lc->cmd == LC_SYMTAB)
3876 symLC = (struct symtab_command*) lc;
3877 else if(lc->cmd == LC_DYSYMTAB)
3878 dsymLC = (struct dysymtab_command*) lc;
3879 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3882 sections = (struct section*) (segLC+1);
3883 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
3886 for(i=0;i<segLC->nsects;i++)
3888 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3889 la_ptrs = §ions[i];
3890 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3891 nl_ptrs = §ions[i];
3896 unsigned long *indirectSyms
3897 = (unsigned long*) (image + dsymLC->indirectsymoff);
3900 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3903 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3907 for(i=0;i<segLC->nsects;i++)
3909 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
3913 /* Free the local symbol table; we won't need it again. */
3914 freeHashTable(oc->lochash, NULL);
3917 #if defined (powerpc_HOST_ARCH)
3918 ocFlushInstructionCache( oc );
3925 * The Mach-O object format uses leading underscores. But not everywhere.
3926 * There is a small number of runtime support functions defined in
3927 * libcc_dynamic.a whose name does not have a leading underscore.
3928 * As a consequence, we can't get their address from C code.
3929 * We have to use inline assembler just to take the address of a function.
3933 static void machoInitSymbolsWithoutUnderscore()
3935 extern void* symbolsWithoutUnderscore[];
3936 void **p = symbolsWithoutUnderscore;
3937 __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
3941 __asm__ volatile(".long " # x);
3943 RTS_MACHO_NOUNDERLINE_SYMBOLS
3945 __asm__ volatile(".text");
3949 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
3951 RTS_MACHO_NOUNDERLINE_SYMBOLS