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_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) \
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) \
396 SymX(blockAsyncExceptionszh_fast) \
398 SymX(catchRetryzh_fast) \
399 SymX(catchSTMzh_fast) \
400 SymX(closure_flags) \
402 SymX(cmpIntegerzh_fast) \
403 SymX(cmpIntegerIntzh_fast) \
404 SymX(complementIntegerzh_fast) \
405 SymX(createAdjustor) \
406 SymX(decodeDoublezh_fast) \
407 SymX(decodeFloatzh_fast) \
410 SymX(deRefWeakzh_fast) \
411 SymX(deRefStablePtrzh_fast) \
412 SymX(divExactIntegerzh_fast) \
413 SymX(divModIntegerzh_fast) \
416 SymX(forkOS_createThread) \
417 SymX(freeHaskellFunctionPtr) \
418 SymX(freeStablePtr) \
419 SymX(gcdIntegerzh_fast) \
420 SymX(gcdIntegerIntzh_fast) \
421 SymX(gcdIntzh_fast) \
427 SymX(int2Integerzh_fast) \
428 SymX(integer2Intzh_fast) \
429 SymX(integer2Wordzh_fast) \
430 SymX(isCurrentThreadBoundzh_fast) \
431 SymX(isDoubleDenormalized) \
432 SymX(isDoubleInfinite) \
434 SymX(isDoubleNegativeZero) \
435 SymX(isEmptyMVarzh_fast) \
436 SymX(isFloatDenormalized) \
437 SymX(isFloatInfinite) \
439 SymX(isFloatNegativeZero) \
440 SymX(killThreadzh_fast) \
443 SymX(makeStablePtrzh_fast) \
444 SymX(minusIntegerzh_fast) \
445 SymX(mkApUpd0zh_fast) \
446 SymX(myThreadIdzh_fast) \
447 SymX(labelThreadzh_fast) \
448 SymX(newArrayzh_fast) \
449 SymX(newBCOzh_fast) \
450 SymX(newByteArrayzh_fast) \
451 SymX_redirect(newCAF, newDynCAF) \
452 SymX(newMVarzh_fast) \
453 SymX(newMutVarzh_fast) \
454 SymX(newTVarzh_fast) \
455 SymX(atomicModifyMutVarzh_fast) \
456 SymX(newPinnedByteArrayzh_fast) \
457 SymX(orIntegerzh_fast) \
459 SymX(performMajorGC) \
460 SymX(plusIntegerzh_fast) \
463 SymX(putMVarzh_fast) \
464 SymX(quotIntegerzh_fast) \
465 SymX(quotRemIntegerzh_fast) \
467 SymX(raiseIOzh_fast) \
468 SymX(readTVarzh_fast) \
469 SymX(remIntegerzh_fast) \
470 SymX(resetNonBlockingFd) \
475 SymX(rts_checkSchedStatus) \
478 SymX(rts_evalLazyIO) \
479 SymX(rts_evalStableIO) \
483 SymX(rts_getDouble) \
488 SymX(rts_getFunPtr) \
489 SymX(rts_getStablePtr) \
490 SymX(rts_getThreadId) \
492 SymX(rts_getWord32) \
505 SymX(rts_mkStablePtr) \
513 SymX(rtsSupportsBoundThreads) \
515 SymX(__hscore_get_saved_termios) \
516 SymX(__hscore_set_saved_termios) \
518 SymX(startupHaskell) \
519 SymX(shutdownHaskell) \
520 SymX(shutdownHaskellAndExit) \
521 SymX(stable_ptr_table) \
522 SymX(stackOverflow) \
523 SymX(stg_CAF_BLACKHOLE_info) \
524 SymX(stg_BLACKHOLE_BQ_info) \
525 SymX(awakenBlockedQueue) \
526 SymX(stg_CHARLIKE_closure) \
527 SymX(stg_EMPTY_MVAR_info) \
528 SymX(stg_IND_STATIC_info) \
529 SymX(stg_INTLIKE_closure) \
530 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
531 SymX(stg_MUT_ARR_PTRS_FROZEN0_info) \
532 SymX(stg_WEAK_info) \
533 SymX(stg_ap_0_info) \
534 SymX(stg_ap_v_info) \
535 SymX(stg_ap_f_info) \
536 SymX(stg_ap_d_info) \
537 SymX(stg_ap_l_info) \
538 SymX(stg_ap_n_info) \
539 SymX(stg_ap_p_info) \
540 SymX(stg_ap_pv_info) \
541 SymX(stg_ap_pp_info) \
542 SymX(stg_ap_ppv_info) \
543 SymX(stg_ap_ppp_info) \
544 SymX(stg_ap_pppv_info) \
545 SymX(stg_ap_pppp_info) \
546 SymX(stg_ap_ppppp_info) \
547 SymX(stg_ap_pppppp_info) \
548 SymX(stg_ap_1_upd_info) \
549 SymX(stg_ap_2_upd_info) \
550 SymX(stg_ap_3_upd_info) \
551 SymX(stg_ap_4_upd_info) \
552 SymX(stg_ap_5_upd_info) \
553 SymX(stg_ap_6_upd_info) \
554 SymX(stg_ap_7_upd_info) \
556 SymX(stg_sel_0_upd_info) \
557 SymX(stg_sel_10_upd_info) \
558 SymX(stg_sel_11_upd_info) \
559 SymX(stg_sel_12_upd_info) \
560 SymX(stg_sel_13_upd_info) \
561 SymX(stg_sel_14_upd_info) \
562 SymX(stg_sel_15_upd_info) \
563 SymX(stg_sel_1_upd_info) \
564 SymX(stg_sel_2_upd_info) \
565 SymX(stg_sel_3_upd_info) \
566 SymX(stg_sel_4_upd_info) \
567 SymX(stg_sel_5_upd_info) \
568 SymX(stg_sel_6_upd_info) \
569 SymX(stg_sel_7_upd_info) \
570 SymX(stg_sel_8_upd_info) \
571 SymX(stg_sel_9_upd_info) \
572 SymX(stg_upd_frame_info) \
573 SymX(suspendThread) \
574 SymX(takeMVarzh_fast) \
575 SymX(timesIntegerzh_fast) \
576 SymX(tryPutMVarzh_fast) \
577 SymX(tryTakeMVarzh_fast) \
578 SymX(unblockAsyncExceptionszh_fast) \
580 SymX(unsafeThawArrayzh_fast) \
581 SymX(waitReadzh_fast) \
582 SymX(waitWritezh_fast) \
583 SymX(word2Integerzh_fast) \
584 SymX(writeTVarzh_fast) \
585 SymX(xorIntegerzh_fast) \
588 #ifdef SUPPORT_LONG_LONGS
589 #define RTS_LONG_LONG_SYMS \
590 SymX(int64ToIntegerzh_fast) \
591 SymX(word64ToIntegerzh_fast)
593 #define RTS_LONG_LONG_SYMS /* nothing */
596 // 64-bit support functions in libgcc.a
597 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
598 #define RTS_LIBGCC_SYMBOLS \
608 #elif defined(ia64_HOST_ARCH)
609 #define RTS_LIBGCC_SYMBOLS \
617 #define RTS_LIBGCC_SYMBOLS
620 #ifdef darwin_HOST_OS
621 // Symbols that don't have a leading underscore
622 // on Mac OS X. They have to receive special treatment,
623 // see machoInitSymbolsWithoutUnderscore()
624 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
629 /* entirely bogus claims about types of these symbols */
630 #define Sym(vvv) extern void vvv(void);
631 #define SymX(vvv) /**/
632 #define SymX_redirect(vvv,xxx) /**/
636 RTS_POSIX_ONLY_SYMBOLS
637 RTS_MINGW_ONLY_SYMBOLS
638 RTS_CYGWIN_ONLY_SYMBOLS
644 #ifdef LEADING_UNDERSCORE
645 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
647 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
650 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
652 #define SymX(vvv) Sym(vvv)
654 // SymX_redirect allows us to redirect references to one symbol to
655 // another symbol. See newCAF/newDynCAF for an example.
656 #define SymX_redirect(vvv,xxx) \
657 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
660 static RtsSymbolVal rtsSyms[] = {
664 RTS_POSIX_ONLY_SYMBOLS
665 RTS_MINGW_ONLY_SYMBOLS
666 RTS_CYGWIN_ONLY_SYMBOLS
668 { 0, 0 } /* sentinel */
671 /* -----------------------------------------------------------------------------
672 * Insert symbols into hash tables, checking for duplicates.
674 static void ghciInsertStrHashTable ( char* obj_name,
680 if (lookupHashTable(table, (StgWord)key) == NULL)
682 insertStrHashTable(table, (StgWord)key, data);
687 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
689 "whilst processing object file\n"
691 "This could be caused by:\n"
692 " * Loading two different object files which export the same symbol\n"
693 " * Specifying the same object file twice on the GHCi command line\n"
694 " * An incorrect `package.conf' entry, causing some object to be\n"
696 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
705 /* -----------------------------------------------------------------------------
706 * initialize the object linker
710 static int linker_init_done = 0 ;
712 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
713 static void *dl_prog_handle;
716 /* dlopen(NULL,..) doesn't work so we grab libc explicitly */
717 #if defined(openbsd_HOST_OS)
718 static void *dl_libc_handle;
726 /* Make initLinker idempotent, so we can call it
727 before evey relevant operation; that means we
728 don't need to initialise the linker separately */
729 if (linker_init_done == 1) { return; } else {
730 linker_init_done = 1;
733 symhash = allocStrHashTable();
735 /* populate the symbol table with stuff from the RTS */
736 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
737 ghciInsertStrHashTable("(GHCi built-in symbols)",
738 symhash, sym->lbl, sym->addr);
740 # if defined(OBJFORMAT_MACHO)
741 machoInitSymbolsWithoutUnderscore();
744 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
745 # if defined(RTLD_DEFAULT)
746 dl_prog_handle = RTLD_DEFAULT;
748 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
749 # if defined(openbsd_HOST_OS)
750 dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
752 # endif // RTLD_DEFAULT
756 /* -----------------------------------------------------------------------------
757 * Loading DLL or .so dynamic libraries
758 * -----------------------------------------------------------------------------
760 * Add a DLL from which symbols may be found. In the ELF case, just
761 * do RTLD_GLOBAL-style add, so no further messing around needs to
762 * happen in order that symbols in the loaded .so are findable --
763 * lookupSymbol() will subsequently see them by dlsym on the program's
764 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
766 * In the PEi386 case, open the DLLs and put handles to them in a
767 * linked list. When looking for a symbol, try all handles in the
768 * list. This means that we need to load even DLLs that are guaranteed
769 * to be in the ghc.exe image already, just so we can get a handle
770 * to give to loadSymbol, so that we can find the symbols. For such
771 * libraries, the LoadLibrary call should be a no-op except for returning
776 #if defined(OBJFORMAT_PEi386)
777 /* A record for storing handles into DLLs. */
782 struct _OpenedDLL* next;
787 /* A list thereof. */
788 static OpenedDLL* opened_dlls = NULL;
792 addDLL( char *dll_name )
794 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
795 /* ------------------- ELF DLL loader ------------------- */
801 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
804 /* dlopen failed; return a ptr to the error msg. */
806 if (errmsg == NULL) errmsg = "addDLL: unknown error";
813 # elif defined(OBJFORMAT_PEi386)
814 /* ------------------- Win32 DLL loader ------------------- */
822 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
824 /* See if we've already got it, and ignore if so. */
825 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
826 if (0 == strcmp(o_dll->name, dll_name))
830 /* The file name has no suffix (yet) so that we can try
831 both foo.dll and foo.drv
833 The documentation for LoadLibrary says:
834 If no file name extension is specified in the lpFileName
835 parameter, the default library extension .dll is
836 appended. However, the file name string can include a trailing
837 point character (.) to indicate that the module name has no
840 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
841 sprintf(buf, "%s.DLL", dll_name);
842 instance = LoadLibrary(buf);
843 if (instance == NULL) {
844 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
845 instance = LoadLibrary(buf);
846 if (instance == NULL) {
849 /* LoadLibrary failed; return a ptr to the error msg. */
850 return "addDLL: unknown error";
855 /* Add this DLL to the list of DLLs in which to search for symbols. */
856 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
857 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
858 strcpy(o_dll->name, dll_name);
859 o_dll->instance = instance;
860 o_dll->next = opened_dlls;
865 barf("addDLL: not implemented on this platform");
869 /* -----------------------------------------------------------------------------
870 * lookup a symbol in the hash table
873 lookupSymbol( char *lbl )
877 ASSERT(symhash != NULL);
878 val = lookupStrHashTable(symhash, lbl);
881 # if defined(OBJFORMAT_ELF)
882 # if defined(openbsd_HOST_OS)
883 val = dlsym(dl_prog_handle, lbl);
884 return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
885 # else /* not openbsd */
886 return dlsym(dl_prog_handle, lbl);
888 # elif defined(OBJFORMAT_MACHO)
889 if(NSIsSymbolNameDefined(lbl)) {
890 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
891 return NSAddressOfSymbol(symbol);
895 # elif defined(OBJFORMAT_PEi386)
898 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
899 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
901 /* HACK: if the name has an initial underscore, try stripping
902 it off & look that up first. I've yet to verify whether there's
903 a Rule that governs whether an initial '_' *should always* be
904 stripped off when mapping from import lib name to the DLL name.
906 sym = GetProcAddress(o_dll->instance, (lbl+1));
908 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
912 sym = GetProcAddress(o_dll->instance, lbl);
914 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
929 __attribute((unused))
931 lookupLocalSymbol( ObjectCode* oc, char *lbl )
935 val = lookupStrHashTable(oc->lochash, lbl);
945 /* -----------------------------------------------------------------------------
946 * Debugging aid: look in GHCi's object symbol tables for symbols
947 * within DELTA bytes of the specified address, and show their names.
950 void ghci_enquire ( char* addr );
952 void ghci_enquire ( char* addr )
957 const int DELTA = 64;
962 for (oc = objects; oc; oc = oc->next) {
963 for (i = 0; i < oc->n_symbols; i++) {
964 sym = oc->symbols[i];
965 if (sym == NULL) continue;
966 // debugBelch("enquire %p %p\n", sym, oc->lochash);
968 if (oc->lochash != NULL) {
969 a = lookupStrHashTable(oc->lochash, sym);
972 a = lookupStrHashTable(symhash, sym);
975 // debugBelch("ghci_enquire: can't find %s\n", sym);
977 else if (addr-DELTA <= a && a <= addr+DELTA) {
978 debugBelch("%p + %3d == `%s'\n", addr, a - addr, sym);
985 #ifdef ia64_HOST_ARCH
986 static unsigned int PLTSize(void);
989 /* -----------------------------------------------------------------------------
990 * Load an obj (populate the global symbol table, but don't resolve yet)
992 * Returns: 1 if ok, 0 on error.
995 loadObj( char *path )
1002 void *map_addr = NULL;
1009 /* debugBelch("loadObj %s\n", path ); */
1011 /* Check that we haven't already loaded this object.
1012 Ignore requests to load multiple times */
1016 for (o = objects; o; o = o->next) {
1017 if (0 == strcmp(o->fileName, path)) {
1019 break; /* don't need to search further */
1023 IF_DEBUG(linker, debugBelch(
1024 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1025 "same object file twice:\n"
1027 "GHCi will ignore this, but be warned.\n"
1029 return 1; /* success */
1033 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1035 # if defined(OBJFORMAT_ELF)
1036 oc->formatName = "ELF";
1037 # elif defined(OBJFORMAT_PEi386)
1038 oc->formatName = "PEi386";
1039 # elif defined(OBJFORMAT_MACHO)
1040 oc->formatName = "Mach-O";
1043 barf("loadObj: not implemented on this platform");
1046 r = stat(path, &st);
1047 if (r == -1) { return 0; }
1049 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1050 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1051 strcpy(oc->fileName, path);
1053 oc->fileSize = st.st_size;
1055 oc->sections = NULL;
1056 oc->lochash = allocStrHashTable();
1057 oc->proddables = NULL;
1059 /* chain it onto the list of objects */
1064 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1066 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1068 #if defined(openbsd_HOST_OS)
1069 fd = open(path, O_RDONLY, S_IRUSR);
1071 fd = open(path, O_RDONLY);
1074 barf("loadObj: can't open `%s'", path);
1076 pagesize = getpagesize();
1078 #ifdef ia64_HOST_ARCH
1079 /* The PLT needs to be right before the object */
1080 n = ROUND_UP(PLTSize(), pagesize);
1081 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1082 if (oc->plt == MAP_FAILED)
1083 barf("loadObj: can't allocate PLT");
1086 map_addr = oc->plt + n;
1089 n = ROUND_UP(oc->fileSize, pagesize);
1090 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1091 if (oc->image == MAP_FAILED)
1092 barf("loadObj: can't map `%s'", path);
1096 #else /* !USE_MMAP */
1098 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1100 /* load the image into memory */
1101 f = fopen(path, "rb");
1103 barf("loadObj: can't read `%s'", path);
1105 n = fread ( oc->image, 1, oc->fileSize, f );
1106 if (n != oc->fileSize)
1107 barf("loadObj: error whilst reading `%s'", path);
1111 #endif /* USE_MMAP */
1113 # if defined(OBJFORMAT_MACHO)
1114 r = ocAllocateJumpIslands_MachO ( oc );
1115 if (!r) { return r; }
1116 # elif defined(OBJFORMAT_ELF) && defined(powerpc_HOST_ARCH)
1117 r = ocAllocateJumpIslands_ELF ( oc );
1118 if (!r) { return r; }
1121 /* verify the in-memory image */
1122 # if defined(OBJFORMAT_ELF)
1123 r = ocVerifyImage_ELF ( oc );
1124 # elif defined(OBJFORMAT_PEi386)
1125 r = ocVerifyImage_PEi386 ( oc );
1126 # elif defined(OBJFORMAT_MACHO)
1127 r = ocVerifyImage_MachO ( oc );
1129 barf("loadObj: no verify method");
1131 if (!r) { return r; }
1133 /* build the symbol list for this image */
1134 # if defined(OBJFORMAT_ELF)
1135 r = ocGetNames_ELF ( oc );
1136 # elif defined(OBJFORMAT_PEi386)
1137 r = ocGetNames_PEi386 ( oc );
1138 # elif defined(OBJFORMAT_MACHO)
1139 r = ocGetNames_MachO ( oc );
1141 barf("loadObj: no getNames method");
1143 if (!r) { return r; }
1145 /* loaded, but not resolved yet */
1146 oc->status = OBJECT_LOADED;
1151 /* -----------------------------------------------------------------------------
1152 * resolve all the currently unlinked objects in memory
1154 * Returns: 1 if ok, 0 on error.
1164 for (oc = objects; oc; oc = oc->next) {
1165 if (oc->status != OBJECT_RESOLVED) {
1166 # if defined(OBJFORMAT_ELF)
1167 r = ocResolve_ELF ( oc );
1168 # elif defined(OBJFORMAT_PEi386)
1169 r = ocResolve_PEi386 ( oc );
1170 # elif defined(OBJFORMAT_MACHO)
1171 r = ocResolve_MachO ( oc );
1173 barf("resolveObjs: not implemented on this platform");
1175 if (!r) { return r; }
1176 oc->status = OBJECT_RESOLVED;
1182 /* -----------------------------------------------------------------------------
1183 * delete an object from the pool
1186 unloadObj( char *path )
1188 ObjectCode *oc, *prev;
1190 ASSERT(symhash != NULL);
1191 ASSERT(objects != NULL);
1196 for (oc = objects; oc; prev = oc, oc = oc->next) {
1197 if (!strcmp(oc->fileName,path)) {
1199 /* Remove all the mappings for the symbols within this
1204 for (i = 0; i < oc->n_symbols; i++) {
1205 if (oc->symbols[i] != NULL) {
1206 removeStrHashTable(symhash, oc->symbols[i], NULL);
1214 prev->next = oc->next;
1217 /* We're going to leave this in place, in case there are
1218 any pointers from the heap into it: */
1219 /* stgFree(oc->image); */
1220 stgFree(oc->fileName);
1221 stgFree(oc->symbols);
1222 stgFree(oc->sections);
1223 /* The local hash table should have been freed at the end
1224 of the ocResolve_ call on it. */
1225 ASSERT(oc->lochash == NULL);
1231 errorBelch("unloadObj: can't find `%s' to unload", path);
1235 /* -----------------------------------------------------------------------------
1236 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1237 * which may be prodded during relocation, and abort if we try and write
1238 * outside any of these.
1240 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1243 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1244 /* debugBelch("aPB %p %p %d\n", oc, start, size); */
1248 pb->next = oc->proddables;
1249 oc->proddables = pb;
1252 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1255 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1256 char* s = (char*)(pb->start);
1257 char* e = s + pb->size - 1;
1258 char* a = (char*)addr;
1259 /* Assumes that the biggest fixup involves a 4-byte write. This
1260 probably needs to be changed to 8 (ie, +7) on 64-bit
1262 if (a >= s && (a+3) <= e) return;
1264 barf("checkProddableBlock: invalid fixup in runtime linker");
1267 /* -----------------------------------------------------------------------------
1268 * Section management.
1270 static void addSection ( ObjectCode* oc, SectionKind kind,
1271 void* start, void* end )
1273 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1277 s->next = oc->sections;
1280 debugBelch("addSection: %p-%p (size %d), kind %d\n",
1281 start, ((char*)end)-1, end - start + 1, kind );
1286 /* --------------------------------------------------------------------------
1287 * PowerPC specifics (jump islands)
1288 * ------------------------------------------------------------------------*/
1290 #if defined(powerpc_HOST_ARCH)
1293 ocAllocateJumpIslands
1295 Allocate additional space at the end of the object file image to make room
1298 PowerPC relative branch instructions have a 24 bit displacement field.
1299 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
1300 If a particular imported symbol is outside this range, we have to redirect
1301 the jump to a short piece of new code that just loads the 32bit absolute
1302 address and jumps there.
1303 This function just allocates space for one 16 byte ppcJumpIsland for every
1304 undefined symbol in the object file. The code for the islands is filled in by
1305 makeJumpIsland below.
1308 static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first )
1315 #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined
1317 // round up to the nearest 4
1318 aligned = (oc->fileSize + 3) & ~3;
1320 oc->image = stgReallocBytes( oc->image,
1321 aligned + sizeof( ppcJumpIsland ) * count,
1322 "ocAllocateJumpIslands" );
1323 oc->jump_islands = (ppcJumpIsland *) (((char *) oc->image) + aligned);
1324 memset( oc->jump_islands, 0, sizeof( ppcJumpIsland ) * count );
1327 oc->jump_islands = NULL;
1329 oc->island_start_symbol = first;
1330 oc->n_islands = count;
1335 static unsigned long makeJumpIsland( ObjectCode* oc,
1336 unsigned long symbolNumber,
1337 unsigned long target )
1339 ppcJumpIsland *island;
1341 if( symbolNumber < oc->island_start_symbol ||
1342 symbolNumber - oc->island_start_symbol > oc->n_islands)
1345 island = &oc->jump_islands[symbolNumber - oc->island_start_symbol];
1347 // lis r12, hi16(target)
1348 island->lis_r12 = 0x3d80;
1349 island->hi_addr = target >> 16;
1351 // ori r12, r12, lo16(target)
1352 island->ori_r12_r12 = 0x618c;
1353 island->lo_addr = target & 0xffff;
1356 island->mtctr_r12 = 0x7d8903a6;
1359 island->bctr = 0x4e800420;
1361 return (unsigned long) island;
1365 ocFlushInstructionCache
1367 Flush the data & instruction caches.
1368 Because the PPC has split data/instruction caches, we have to
1369 do that whenever we modify code at runtime.
1372 static void ocFlushInstructionCache( ObjectCode *oc )
1374 int n = (oc->fileSize + sizeof( ppcJumpIsland ) * oc->n_islands + 3) / 4;
1375 unsigned long *p = (unsigned long *) oc->image;
1379 __asm__ volatile ( "dcbf 0,%0\n\t"
1387 __asm__ volatile ( "sync\n\t"
1393 /* --------------------------------------------------------------------------
1394 * PEi386 specifics (Win32 targets)
1395 * ------------------------------------------------------------------------*/
1397 /* The information for this linker comes from
1398 Microsoft Portable Executable
1399 and Common Object File Format Specification
1400 revision 5.1 January 1998
1401 which SimonM says comes from the MS Developer Network CDs.
1403 It can be found there (on older CDs), but can also be found
1406 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1408 (this is Rev 6.0 from February 1999).
1410 Things move, so if that fails, try searching for it via
1412 http://www.google.com/search?q=PE+COFF+specification
1414 The ultimate reference for the PE format is the Winnt.h
1415 header file that comes with the Platform SDKs; as always,
1416 implementations will drift wrt their documentation.
1418 A good background article on the PE format is Matt Pietrek's
1419 March 1994 article in Microsoft System Journal (MSJ)
1420 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1421 Win32 Portable Executable File Format." The info in there
1422 has recently been updated in a two part article in
1423 MSDN magazine, issues Feb and March 2002,
1424 "Inside Windows: An In-Depth Look into the Win32 Portable
1425 Executable File Format"
1427 John Levine's book "Linkers and Loaders" contains useful
1432 #if defined(OBJFORMAT_PEi386)
1436 typedef unsigned char UChar;
1437 typedef unsigned short UInt16;
1438 typedef unsigned int UInt32;
1445 UInt16 NumberOfSections;
1446 UInt32 TimeDateStamp;
1447 UInt32 PointerToSymbolTable;
1448 UInt32 NumberOfSymbols;
1449 UInt16 SizeOfOptionalHeader;
1450 UInt16 Characteristics;
1454 #define sizeof_COFF_header 20
1461 UInt32 VirtualAddress;
1462 UInt32 SizeOfRawData;
1463 UInt32 PointerToRawData;
1464 UInt32 PointerToRelocations;
1465 UInt32 PointerToLinenumbers;
1466 UInt16 NumberOfRelocations;
1467 UInt16 NumberOfLineNumbers;
1468 UInt32 Characteristics;
1472 #define sizeof_COFF_section 40
1479 UInt16 SectionNumber;
1482 UChar NumberOfAuxSymbols;
1486 #define sizeof_COFF_symbol 18
1491 UInt32 VirtualAddress;
1492 UInt32 SymbolTableIndex;
1497 #define sizeof_COFF_reloc 10
1500 /* From PE spec doc, section 3.3.2 */
1501 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1502 windows.h -- for the same purpose, but I want to know what I'm
1504 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1505 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1506 #define MYIMAGE_FILE_DLL 0x2000
1507 #define MYIMAGE_FILE_SYSTEM 0x1000
1508 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1509 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1510 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1512 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1513 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1514 #define MYIMAGE_SYM_CLASS_STATIC 3
1515 #define MYIMAGE_SYM_UNDEFINED 0
1517 /* From PE spec doc, section 4.1 */
1518 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1519 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1520 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1522 /* From PE spec doc, section 5.2.1 */
1523 #define MYIMAGE_REL_I386_DIR32 0x0006
1524 #define MYIMAGE_REL_I386_REL32 0x0014
1527 /* We use myindex to calculate array addresses, rather than
1528 simply doing the normal subscript thing. That's because
1529 some of the above structs have sizes which are not
1530 a whole number of words. GCC rounds their sizes up to a
1531 whole number of words, which means that the address calcs
1532 arising from using normal C indexing or pointer arithmetic
1533 are just plain wrong. Sigh.
1536 myindex ( int scale, void* base, int index )
1539 ((UChar*)base) + scale * index;
1544 printName ( UChar* name, UChar* strtab )
1546 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1547 UInt32 strtab_offset = * (UInt32*)(name+4);
1548 debugBelch("%s", strtab + strtab_offset );
1551 for (i = 0; i < 8; i++) {
1552 if (name[i] == 0) break;
1553 debugBelch("%c", name[i] );
1560 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1562 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1563 UInt32 strtab_offset = * (UInt32*)(name+4);
1564 strncpy ( dst, strtab+strtab_offset, dstSize );
1570 if (name[i] == 0) break;
1580 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1583 /* If the string is longer than 8 bytes, look in the
1584 string table for it -- this will be correctly zero terminated.
1586 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1587 UInt32 strtab_offset = * (UInt32*)(name+4);
1588 return ((UChar*)strtab) + strtab_offset;
1590 /* Otherwise, if shorter than 8 bytes, return the original,
1591 which by defn is correctly terminated.
1593 if (name[7]==0) return name;
1594 /* The annoying case: 8 bytes. Copy into a temporary
1595 (which is never freed ...)
1597 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1599 strncpy(newstr,name,8);
1605 /* Just compares the short names (first 8 chars) */
1606 static COFF_section *
1607 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1611 = (COFF_header*)(oc->image);
1612 COFF_section* sectab
1614 ((UChar*)(oc->image))
1615 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1617 for (i = 0; i < hdr->NumberOfSections; i++) {
1620 COFF_section* section_i
1622 myindex ( sizeof_COFF_section, sectab, i );
1623 n1 = (UChar*) &(section_i->Name);
1625 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1626 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1627 n1[6]==n2[6] && n1[7]==n2[7])
1636 zapTrailingAtSign ( UChar* sym )
1638 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1640 if (sym[0] == 0) return;
1642 while (sym[i] != 0) i++;
1645 while (j > 0 && my_isdigit(sym[j])) j--;
1646 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1652 ocVerifyImage_PEi386 ( ObjectCode* oc )
1657 COFF_section* sectab;
1658 COFF_symbol* symtab;
1660 /* debugBelch("\nLOADING %s\n", oc->fileName); */
1661 hdr = (COFF_header*)(oc->image);
1662 sectab = (COFF_section*) (
1663 ((UChar*)(oc->image))
1664 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1666 symtab = (COFF_symbol*) (
1667 ((UChar*)(oc->image))
1668 + hdr->PointerToSymbolTable
1670 strtab = ((UChar*)symtab)
1671 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1673 if (hdr->Machine != 0x14c) {
1674 errorBelch("Not x86 PEi386");
1677 if (hdr->SizeOfOptionalHeader != 0) {
1678 errorBelch("PEi386 with nonempty optional header");
1681 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1682 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1683 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1684 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1685 errorBelch("Not a PEi386 object file");
1688 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1689 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1690 errorBelch("Invalid PEi386 word size or endiannness: %d",
1691 (int)(hdr->Characteristics));
1694 /* If the string table size is way crazy, this might indicate that
1695 there are more than 64k relocations, despite claims to the
1696 contrary. Hence this test. */
1697 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
1699 if ( (*(UInt32*)strtab) > 600000 ) {
1700 /* Note that 600k has no special significance other than being
1701 big enough to handle the almost-2MB-sized lumps that
1702 constitute HSwin32*.o. */
1703 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
1708 /* No further verification after this point; only debug printing. */
1710 IF_DEBUG(linker, i=1);
1711 if (i == 0) return 1;
1713 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1714 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1715 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1718 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1719 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1720 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1721 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1722 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1723 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1724 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1726 /* Print the section table. */
1728 for (i = 0; i < hdr->NumberOfSections; i++) {
1730 COFF_section* sectab_i
1732 myindex ( sizeof_COFF_section, sectab, i );
1739 printName ( sectab_i->Name, strtab );
1749 sectab_i->VirtualSize,
1750 sectab_i->VirtualAddress,
1751 sectab_i->SizeOfRawData,
1752 sectab_i->PointerToRawData,
1753 sectab_i->NumberOfRelocations,
1754 sectab_i->PointerToRelocations,
1755 sectab_i->PointerToRawData
1757 reltab = (COFF_reloc*) (
1758 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1761 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1762 /* If the relocation field (a short) has overflowed, the
1763 * real count can be found in the first reloc entry.
1765 * See Section 4.1 (last para) of the PE spec (rev6.0).
1767 COFF_reloc* rel = (COFF_reloc*)
1768 myindex ( sizeof_COFF_reloc, reltab, 0 );
1769 noRelocs = rel->VirtualAddress;
1772 noRelocs = sectab_i->NumberOfRelocations;
1776 for (; j < noRelocs; j++) {
1778 COFF_reloc* rel = (COFF_reloc*)
1779 myindex ( sizeof_COFF_reloc, reltab, j );
1781 " type 0x%-4x vaddr 0x%-8x name `",
1783 rel->VirtualAddress );
1784 sym = (COFF_symbol*)
1785 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1786 /* Hmm..mysterious looking offset - what's it for? SOF */
1787 printName ( sym->Name, strtab -10 );
1794 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
1795 debugBelch("---START of string table---\n");
1796 for (i = 4; i < *(Int32*)strtab; i++) {
1798 debugBelch("\n"); else
1799 debugBelch("%c", strtab[i] );
1801 debugBelch("--- END of string table---\n");
1806 COFF_symbol* symtab_i;
1807 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1808 symtab_i = (COFF_symbol*)
1809 myindex ( sizeof_COFF_symbol, symtab, i );
1815 printName ( symtab_i->Name, strtab );
1824 (Int32)(symtab_i->SectionNumber),
1825 (UInt32)symtab_i->Type,
1826 (UInt32)symtab_i->StorageClass,
1827 (UInt32)symtab_i->NumberOfAuxSymbols
1829 i += symtab_i->NumberOfAuxSymbols;
1839 ocGetNames_PEi386 ( ObjectCode* oc )
1842 COFF_section* sectab;
1843 COFF_symbol* symtab;
1850 hdr = (COFF_header*)(oc->image);
1851 sectab = (COFF_section*) (
1852 ((UChar*)(oc->image))
1853 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1855 symtab = (COFF_symbol*) (
1856 ((UChar*)(oc->image))
1857 + hdr->PointerToSymbolTable
1859 strtab = ((UChar*)(oc->image))
1860 + hdr->PointerToSymbolTable
1861 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1863 /* Allocate space for any (local, anonymous) .bss sections. */
1865 for (i = 0; i < hdr->NumberOfSections; i++) {
1867 COFF_section* sectab_i
1869 myindex ( sizeof_COFF_section, sectab, i );
1870 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1871 if (sectab_i->VirtualSize == 0) continue;
1872 /* This is a non-empty .bss section. Allocate zeroed space for
1873 it, and set its PointerToRawData field such that oc->image +
1874 PointerToRawData == addr_of_zeroed_space. */
1875 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1876 "ocGetNames_PEi386(anonymous bss)");
1877 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1878 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1879 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
1882 /* Copy section information into the ObjectCode. */
1884 for (i = 0; i < hdr->NumberOfSections; i++) {
1890 = SECTIONKIND_OTHER;
1891 COFF_section* sectab_i
1893 myindex ( sizeof_COFF_section, sectab, i );
1894 IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
1897 /* I'm sure this is the Right Way to do it. However, the
1898 alternative of testing the sectab_i->Name field seems to
1899 work ok with Cygwin.
1901 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1902 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1903 kind = SECTIONKIND_CODE_OR_RODATA;
1906 if (0==strcmp(".text",sectab_i->Name) ||
1907 0==strcmp(".rodata",sectab_i->Name))
1908 kind = SECTIONKIND_CODE_OR_RODATA;
1909 if (0==strcmp(".data",sectab_i->Name) ||
1910 0==strcmp(".bss",sectab_i->Name))
1911 kind = SECTIONKIND_RWDATA;
1913 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1914 sz = sectab_i->SizeOfRawData;
1915 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1917 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1918 end = start + sz - 1;
1920 if (kind == SECTIONKIND_OTHER
1921 /* Ignore sections called which contain stabs debugging
1923 && 0 != strcmp(".stab", sectab_i->Name)
1924 && 0 != strcmp(".stabstr", sectab_i->Name)
1926 errorBelch("Unknown PEi386 section name `%s'", sectab_i->Name);
1930 if (kind != SECTIONKIND_OTHER && end >= start) {
1931 addSection(oc, kind, start, end);
1932 addProddableBlock(oc, start, end - start + 1);
1936 /* Copy exported symbols into the ObjectCode. */
1938 oc->n_symbols = hdr->NumberOfSymbols;
1939 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1940 "ocGetNames_PEi386(oc->symbols)");
1941 /* Call me paranoid; I don't care. */
1942 for (i = 0; i < oc->n_symbols; i++)
1943 oc->symbols[i] = NULL;
1947 COFF_symbol* symtab_i;
1948 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1949 symtab_i = (COFF_symbol*)
1950 myindex ( sizeof_COFF_symbol, symtab, i );
1954 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1955 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1956 /* This symbol is global and defined, viz, exported */
1957 /* for MYIMAGE_SYMCLASS_EXTERNAL
1958 && !MYIMAGE_SYM_UNDEFINED,
1959 the address of the symbol is:
1960 address of relevant section + offset in section
1962 COFF_section* sectabent
1963 = (COFF_section*) myindex ( sizeof_COFF_section,
1965 symtab_i->SectionNumber-1 );
1966 addr = ((UChar*)(oc->image))
1967 + (sectabent->PointerToRawData
1971 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1972 && symtab_i->Value > 0) {
1973 /* This symbol isn't in any section at all, ie, global bss.
1974 Allocate zeroed space for it. */
1975 addr = stgCallocBytes(1, symtab_i->Value,
1976 "ocGetNames_PEi386(non-anonymous bss)");
1977 addSection(oc, SECTIONKIND_RWDATA, addr,
1978 ((UChar*)addr) + symtab_i->Value - 1);
1979 addProddableBlock(oc, addr, symtab_i->Value);
1980 /* debugBelch("BSS section at 0x%x\n", addr); */
1983 if (addr != NULL ) {
1984 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1985 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
1986 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
1987 ASSERT(i >= 0 && i < oc->n_symbols);
1988 /* cstring_from_COFF_symbol_name always succeeds. */
1989 oc->symbols[i] = sname;
1990 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1994 "IGNORING symbol %d\n"
1998 printName ( symtab_i->Name, strtab );
2007 (Int32)(symtab_i->SectionNumber),
2008 (UInt32)symtab_i->Type,
2009 (UInt32)symtab_i->StorageClass,
2010 (UInt32)symtab_i->NumberOfAuxSymbols
2015 i += symtab_i->NumberOfAuxSymbols;
2024 ocResolve_PEi386 ( ObjectCode* oc )
2027 COFF_section* sectab;
2028 COFF_symbol* symtab;
2038 /* ToDo: should be variable-sized? But is at least safe in the
2039 sense of buffer-overrun-proof. */
2041 /* debugBelch("resolving for %s\n", oc->fileName); */
2043 hdr = (COFF_header*)(oc->image);
2044 sectab = (COFF_section*) (
2045 ((UChar*)(oc->image))
2046 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2048 symtab = (COFF_symbol*) (
2049 ((UChar*)(oc->image))
2050 + hdr->PointerToSymbolTable
2052 strtab = ((UChar*)(oc->image))
2053 + hdr->PointerToSymbolTable
2054 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2056 for (i = 0; i < hdr->NumberOfSections; i++) {
2057 COFF_section* sectab_i
2059 myindex ( sizeof_COFF_section, sectab, i );
2062 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2065 /* Ignore sections called which contain stabs debugging
2067 if (0 == strcmp(".stab", sectab_i->Name)
2068 || 0 == strcmp(".stabstr", sectab_i->Name))
2071 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2072 /* If the relocation field (a short) has overflowed, the
2073 * real count can be found in the first reloc entry.
2075 * See Section 4.1 (last para) of the PE spec (rev6.0).
2077 * Nov2003 update: the GNU linker still doesn't correctly
2078 * handle the generation of relocatable object files with
2079 * overflown relocations. Hence the output to warn of potential
2082 COFF_reloc* rel = (COFF_reloc*)
2083 myindex ( sizeof_COFF_reloc, reltab, 0 );
2084 noRelocs = rel->VirtualAddress;
2085 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
2089 noRelocs = sectab_i->NumberOfRelocations;
2094 for (; j < noRelocs; j++) {
2096 COFF_reloc* reltab_j
2098 myindex ( sizeof_COFF_reloc, reltab, j );
2100 /* the location to patch */
2102 ((UChar*)(oc->image))
2103 + (sectab_i->PointerToRawData
2104 + reltab_j->VirtualAddress
2105 - sectab_i->VirtualAddress )
2107 /* the existing contents of pP */
2109 /* the symbol to connect to */
2110 sym = (COFF_symbol*)
2111 myindex ( sizeof_COFF_symbol,
2112 symtab, reltab_j->SymbolTableIndex );
2115 "reloc sec %2d num %3d: type 0x%-4x "
2116 "vaddr 0x%-8x name `",
2118 (UInt32)reltab_j->Type,
2119 reltab_j->VirtualAddress );
2120 printName ( sym->Name, strtab );
2121 debugBelch("'\n" ));
2123 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2124 COFF_section* section_sym
2125 = findPEi386SectionCalled ( oc, sym->Name );
2127 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
2130 S = ((UInt32)(oc->image))
2131 + (section_sym->PointerToRawData
2134 copyName ( sym->Name, strtab, symbol, 1000-1 );
2135 (void*)S = lookupLocalSymbol( oc, symbol );
2136 if ((void*)S != NULL) goto foundit;
2137 (void*)S = lookupSymbol( symbol );
2138 if ((void*)S != NULL) goto foundit;
2139 zapTrailingAtSign ( symbol );
2140 (void*)S = lookupLocalSymbol( oc, symbol );
2141 if ((void*)S != NULL) goto foundit;
2142 (void*)S = lookupSymbol( symbol );
2143 if ((void*)S != NULL) goto foundit;
2144 /* Newline first because the interactive linker has printed "linking..." */
2145 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2149 checkProddableBlock(oc, pP);
2150 switch (reltab_j->Type) {
2151 case MYIMAGE_REL_I386_DIR32:
2154 case MYIMAGE_REL_I386_REL32:
2155 /* Tricky. We have to insert a displacement at
2156 pP which, when added to the PC for the _next_
2157 insn, gives the address of the target (S).
2158 Problem is to know the address of the next insn
2159 when we only know pP. We assume that this
2160 literal field is always the last in the insn,
2161 so that the address of the next insn is pP+4
2162 -- hence the constant 4.
2163 Also I don't know if A should be added, but so
2164 far it has always been zero.
2167 *pP = S - ((UInt32)pP) - 4;
2170 debugBelch("%s: unhandled PEi386 relocation type %d",
2171 oc->fileName, reltab_j->Type);
2178 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
2182 #endif /* defined(OBJFORMAT_PEi386) */
2185 /* --------------------------------------------------------------------------
2187 * ------------------------------------------------------------------------*/
2189 #if defined(OBJFORMAT_ELF)
2194 #if defined(sparc_HOST_ARCH)
2195 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2196 #elif defined(i386_HOST_ARCH)
2197 # define ELF_TARGET_386 /* Used inside <elf.h> */
2198 #elif defined(x86_64_HOST_ARCH)
2199 # define ELF_TARGET_X64_64
2201 #elif defined (ia64_HOST_ARCH)
2202 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2204 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2205 # define ELF_NEED_GOT /* needs Global Offset Table */
2206 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2209 #if !defined(openbsd_HOST_OS)
2212 /* openbsd elf has things in different places, with diff names */
2213 #include <elf_abi.h>
2214 #include <machine/reloc.h>
2215 #define R_386_32 RELOC_32
2216 #define R_386_PC32 RELOC_PC32
2220 * Define a set of types which can be used for both ELF32 and ELF64
2224 #define ELFCLASS ELFCLASS64
2225 #define Elf_Addr Elf64_Addr
2226 #define Elf_Word Elf64_Word
2227 #define Elf_Sword Elf64_Sword
2228 #define Elf_Ehdr Elf64_Ehdr
2229 #define Elf_Phdr Elf64_Phdr
2230 #define Elf_Shdr Elf64_Shdr
2231 #define Elf_Sym Elf64_Sym
2232 #define Elf_Rel Elf64_Rel
2233 #define Elf_Rela Elf64_Rela
2234 #define ELF_ST_TYPE ELF64_ST_TYPE
2235 #define ELF_ST_BIND ELF64_ST_BIND
2236 #define ELF_R_TYPE ELF64_R_TYPE
2237 #define ELF_R_SYM ELF64_R_SYM
2239 #define ELFCLASS ELFCLASS32
2240 #define Elf_Addr Elf32_Addr
2241 #define Elf_Word Elf32_Word
2242 #define Elf_Sword Elf32_Sword
2243 #define Elf_Ehdr Elf32_Ehdr
2244 #define Elf_Phdr Elf32_Phdr
2245 #define Elf_Shdr Elf32_Shdr
2246 #define Elf_Sym Elf32_Sym
2247 #define Elf_Rel Elf32_Rel
2248 #define Elf_Rela Elf32_Rela
2250 #define ELF_ST_TYPE ELF32_ST_TYPE
2253 #define ELF_ST_BIND ELF32_ST_BIND
2256 #define ELF_R_TYPE ELF32_R_TYPE
2259 #define ELF_R_SYM ELF32_R_SYM
2265 * Functions to allocate entries in dynamic sections. Currently we simply
2266 * preallocate a large number, and we don't check if a entry for the given
2267 * target already exists (a linear search is too slow). Ideally these
2268 * entries would be associated with symbols.
2271 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2272 #define GOT_SIZE 0x20000
2273 #define FUNCTION_TABLE_SIZE 0x10000
2274 #define PLT_SIZE 0x08000
2277 static Elf_Addr got[GOT_SIZE];
2278 static unsigned int gotIndex;
2279 static Elf_Addr gp_val = (Elf_Addr)got;
2282 allocateGOTEntry(Elf_Addr target)
2286 if (gotIndex >= GOT_SIZE)
2287 barf("Global offset table overflow");
2289 entry = &got[gotIndex++];
2291 return (Elf_Addr)entry;
2295 #ifdef ELF_FUNCTION_DESC
2301 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2302 static unsigned int functionTableIndex;
2305 allocateFunctionDesc(Elf_Addr target)
2307 FunctionDesc *entry;
2309 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2310 barf("Function table overflow");
2312 entry = &functionTable[functionTableIndex++];
2314 entry->gp = (Elf_Addr)gp_val;
2315 return (Elf_Addr)entry;
2319 copyFunctionDesc(Elf_Addr target)
2321 FunctionDesc *olddesc = (FunctionDesc *)target;
2322 FunctionDesc *newdesc;
2324 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2325 newdesc->gp = olddesc->gp;
2326 return (Elf_Addr)newdesc;
2331 #ifdef ia64_HOST_ARCH
2332 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2333 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2335 static unsigned char plt_code[] =
2337 /* taken from binutils bfd/elfxx-ia64.c */
2338 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2339 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2340 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2341 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2342 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2343 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2346 /* If we can't get to the function descriptor via gp, take a local copy of it */
2347 #define PLT_RELOC(code, target) { \
2348 Elf64_Sxword rel_value = target - gp_val; \
2349 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2350 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2352 ia64_reloc_gprel22((Elf_Addr)code, target); \
2357 unsigned char code[sizeof(plt_code)];
2361 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2363 PLTEntry *plt = (PLTEntry *)oc->plt;
2366 if (oc->pltIndex >= PLT_SIZE)
2367 barf("Procedure table overflow");
2369 entry = &plt[oc->pltIndex++];
2370 memcpy(entry->code, plt_code, sizeof(entry->code));
2371 PLT_RELOC(entry->code, target);
2372 return (Elf_Addr)entry;
2378 return (PLT_SIZE * sizeof(PLTEntry));
2384 * Generic ELF functions
2388 findElfSection ( void* objImage, Elf_Word sh_type )
2390 char* ehdrC = (char*)objImage;
2391 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2392 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2393 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2397 for (i = 0; i < ehdr->e_shnum; i++) {
2398 if (shdr[i].sh_type == sh_type
2399 /* Ignore the section header's string table. */
2400 && i != ehdr->e_shstrndx
2401 /* Ignore string tables named .stabstr, as they contain
2403 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2405 ptr = ehdrC + shdr[i].sh_offset;
2412 #if defined(ia64_HOST_ARCH)
2414 findElfSegment ( void* objImage, Elf_Addr vaddr )
2416 char* ehdrC = (char*)objImage;
2417 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2418 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2419 Elf_Addr segaddr = 0;
2422 for (i = 0; i < ehdr->e_phnum; i++) {
2423 segaddr = phdr[i].p_vaddr;
2424 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2432 ocVerifyImage_ELF ( ObjectCode* oc )
2436 int i, j, nent, nstrtab, nsymtabs;
2440 char* ehdrC = (char*)(oc->image);
2441 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2443 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2444 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2445 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2446 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2447 errorBelch("%s: not an ELF object", oc->fileName);
2451 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2452 errorBelch("%s: unsupported ELF format", oc->fileName);
2456 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2457 IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
2459 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2460 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
2462 errorBelch("%s: unknown endiannness", oc->fileName);
2466 if (ehdr->e_type != ET_REL) {
2467 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
2470 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
2472 IF_DEBUG(linker,debugBelch( "Architecture is " ));
2473 switch (ehdr->e_machine) {
2474 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
2475 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
2477 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
2479 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
2480 default: IF_DEBUG(linker,debugBelch( "unknown" ));
2481 errorBelch("%s: unknown architecture", oc->fileName);
2485 IF_DEBUG(linker,debugBelch(
2486 "\nSection header table: start %d, n_entries %d, ent_size %d\n",
2487 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2489 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2491 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2493 if (ehdr->e_shstrndx == SHN_UNDEF) {
2494 errorBelch("%s: no section header string table", oc->fileName);
2497 IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
2499 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2502 for (i = 0; i < ehdr->e_shnum; i++) {
2503 IF_DEBUG(linker,debugBelch("%2d: ", i ));
2504 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
2505 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
2506 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
2507 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
2508 ehdrC + shdr[i].sh_offset,
2509 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2511 if (shdr[i].sh_type == SHT_REL) {
2512 IF_DEBUG(linker,debugBelch("Rel " ));
2513 } else if (shdr[i].sh_type == SHT_RELA) {
2514 IF_DEBUG(linker,debugBelch("RelA " ));
2516 IF_DEBUG(linker,debugBelch(" "));
2519 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
2523 IF_DEBUG(linker,debugBelch( "\nString tables" ));
2526 for (i = 0; i < ehdr->e_shnum; i++) {
2527 if (shdr[i].sh_type == SHT_STRTAB
2528 /* Ignore the section header's string table. */
2529 && i != ehdr->e_shstrndx
2530 /* Ignore string tables named .stabstr, as they contain
2532 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2534 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
2535 strtab = ehdrC + shdr[i].sh_offset;
2540 errorBelch("%s: no string tables, or too many", oc->fileName);
2545 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
2546 for (i = 0; i < ehdr->e_shnum; i++) {
2547 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2548 IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
2550 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2551 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2552 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%d rem)\n",
2554 shdr[i].sh_size % sizeof(Elf_Sym)
2556 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2557 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
2560 for (j = 0; j < nent; j++) {
2561 IF_DEBUG(linker,debugBelch(" %2d ", j ));
2562 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
2563 (int)stab[j].st_shndx,
2564 (int)stab[j].st_size,
2565 (char*)stab[j].st_value ));
2567 IF_DEBUG(linker,debugBelch("type=" ));
2568 switch (ELF_ST_TYPE(stab[j].st_info)) {
2569 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
2570 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
2571 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
2572 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
2573 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
2574 default: IF_DEBUG(linker,debugBelch("? " )); break;
2576 IF_DEBUG(linker,debugBelch(" " ));
2578 IF_DEBUG(linker,debugBelch("bind=" ));
2579 switch (ELF_ST_BIND(stab[j].st_info)) {
2580 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
2581 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
2582 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
2583 default: IF_DEBUG(linker,debugBelch("? " )); break;
2585 IF_DEBUG(linker,debugBelch(" " ));
2587 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
2591 if (nsymtabs == 0) {
2592 errorBelch("%s: didn't find any symbol tables", oc->fileName);
2599 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
2603 if (hdr->sh_type == SHT_PROGBITS
2604 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
2605 /* .text-style section */
2606 return SECTIONKIND_CODE_OR_RODATA;
2609 if (hdr->sh_type == SHT_PROGBITS
2610 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2611 /* .data-style section */
2612 return SECTIONKIND_RWDATA;
2615 if (hdr->sh_type == SHT_PROGBITS
2616 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
2617 /* .rodata-style section */
2618 return SECTIONKIND_CODE_OR_RODATA;
2621 if (hdr->sh_type == SHT_NOBITS
2622 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2623 /* .bss-style section */
2625 return SECTIONKIND_RWDATA;
2628 return SECTIONKIND_OTHER;
2633 ocGetNames_ELF ( ObjectCode* oc )
2638 char* ehdrC = (char*)(oc->image);
2639 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2640 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2641 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2643 ASSERT(symhash != NULL);
2646 errorBelch("%s: no strtab", oc->fileName);
2651 for (i = 0; i < ehdr->e_shnum; i++) {
2652 /* Figure out what kind of section it is. Logic derived from
2653 Figure 1.14 ("Special Sections") of the ELF document
2654 ("Portable Formats Specification, Version 1.1"). */
2656 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
2658 if (is_bss && shdr[i].sh_size > 0) {
2659 /* This is a non-empty .bss section. Allocate zeroed space for
2660 it, and set its .sh_offset field such that
2661 ehdrC + .sh_offset == addr_of_zeroed_space. */
2662 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2663 "ocGetNames_ELF(BSS)");
2664 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2666 debugBelch("BSS section at 0x%x, size %d\n",
2667 zspace, shdr[i].sh_size);
2671 /* fill in the section info */
2672 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2673 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2674 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2675 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2678 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2680 /* copy stuff into this module's object symbol table */
2681 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2682 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2684 oc->n_symbols = nent;
2685 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2686 "ocGetNames_ELF(oc->symbols)");
2688 for (j = 0; j < nent; j++) {
2690 char isLocal = FALSE; /* avoids uninit-var warning */
2692 char* nm = strtab + stab[j].st_name;
2693 int secno = stab[j].st_shndx;
2695 /* Figure out if we want to add it; if so, set ad to its
2696 address. Otherwise leave ad == NULL. */
2698 if (secno == SHN_COMMON) {
2700 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2702 debugBelch("COMMON symbol, size %d name %s\n",
2703 stab[j].st_size, nm);
2705 /* Pointless to do addProddableBlock() for this area,
2706 since the linker should never poke around in it. */
2709 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2710 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2712 /* and not an undefined symbol */
2713 && stab[j].st_shndx != SHN_UNDEF
2714 /* and not in a "special section" */
2715 && stab[j].st_shndx < SHN_LORESERVE
2717 /* and it's a not a section or string table or anything silly */
2718 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2719 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2720 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2723 /* Section 0 is the undefined section, hence > and not >=. */
2724 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2726 if (shdr[secno].sh_type == SHT_NOBITS) {
2727 debugBelch(" BSS symbol, size %d off %d name %s\n",
2728 stab[j].st_size, stab[j].st_value, nm);
2731 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2732 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2735 #ifdef ELF_FUNCTION_DESC
2736 /* dlsym() and the initialisation table both give us function
2737 * descriptors, so to be consistent we store function descriptors
2738 * in the symbol table */
2739 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2740 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2742 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s",
2743 ad, oc->fileName, nm ));
2748 /* And the decision is ... */
2752 oc->symbols[j] = nm;
2755 /* Ignore entirely. */
2757 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2761 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
2762 strtab + stab[j].st_name ));
2765 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2766 (int)ELF_ST_BIND(stab[j].st_info),
2767 (int)ELF_ST_TYPE(stab[j].st_info),
2768 (int)stab[j].st_shndx,
2769 strtab + stab[j].st_name
2772 oc->symbols[j] = NULL;
2781 /* Do ELF relocations which lack an explicit addend. All x86-linux
2782 relocations appear to be of this form. */
2784 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2785 Elf_Shdr* shdr, int shnum,
2786 Elf_Sym* stab, char* strtab )
2791 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2792 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2793 int target_shndx = shdr[shnum].sh_info;
2794 int symtab_shndx = shdr[shnum].sh_link;
2796 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2797 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2798 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
2799 target_shndx, symtab_shndx ));
2801 /* Skip sections that we're not interested in. */
2804 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
2805 if (kind == SECTIONKIND_OTHER) {
2806 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
2811 for (j = 0; j < nent; j++) {
2812 Elf_Addr offset = rtab[j].r_offset;
2813 Elf_Addr info = rtab[j].r_info;
2815 Elf_Addr P = ((Elf_Addr)targ) + offset;
2816 Elf_Word* pP = (Elf_Word*)P;
2822 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
2823 j, (void*)offset, (void*)info ));
2825 IF_DEBUG(linker,debugBelch( " ZERO" ));
2828 Elf_Sym sym = stab[ELF_R_SYM(info)];
2829 /* First see if it is a local symbol. */
2830 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2831 /* Yes, so we can get the address directly from the ELF symbol
2833 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2835 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2836 + stab[ELF_R_SYM(info)].st_value);
2839 /* No, so look up the name in our global table. */
2840 symbol = strtab + sym.st_name;
2841 S_tmp = lookupSymbol( symbol );
2842 S = (Elf_Addr)S_tmp;
2845 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
2848 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
2851 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
2852 (void*)P, (void*)S, (void*)A ));
2853 checkProddableBlock ( oc, pP );
2857 switch (ELF_R_TYPE(info)) {
2858 # ifdef i386_HOST_ARCH
2859 case R_386_32: *pP = value; break;
2860 case R_386_PC32: *pP = value - P; break;
2863 errorBelch("%s: unhandled ELF relocation(Rel) type %d\n",
2864 oc->fileName, ELF_R_TYPE(info));
2872 /* Do ELF relocations for which explicit addends are supplied.
2873 sparc-solaris relocations appear to be of this form. */
2875 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2876 Elf_Shdr* shdr, int shnum,
2877 Elf_Sym* stab, char* strtab )
2882 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2883 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2884 int target_shndx = shdr[shnum].sh_info;
2885 int symtab_shndx = shdr[shnum].sh_link;
2887 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2888 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2889 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
2890 target_shndx, symtab_shndx ));
2892 for (j = 0; j < nent; j++) {
2893 #if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH)
2894 /* This #ifdef only serves to avoid unused-var warnings. */
2895 Elf_Addr offset = rtab[j].r_offset;
2896 Elf_Addr P = targ + offset;
2898 Elf_Addr info = rtab[j].r_info;
2899 Elf_Addr A = rtab[j].r_addend;
2903 # if defined(sparc_HOST_ARCH)
2904 Elf_Word* pP = (Elf_Word*)P;
2906 # elif defined(ia64_HOST_ARCH)
2907 Elf64_Xword *pP = (Elf64_Xword *)P;
2909 # elif defined(powerpc_HOST_ARCH)
2913 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
2914 j, (void*)offset, (void*)info,
2917 IF_DEBUG(linker,debugBelch( " ZERO" ));
2920 Elf_Sym sym = stab[ELF_R_SYM(info)];
2921 /* First see if it is a local symbol. */
2922 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2923 /* Yes, so we can get the address directly from the ELF symbol
2925 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2927 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2928 + stab[ELF_R_SYM(info)].st_value);
2929 #ifdef ELF_FUNCTION_DESC
2930 /* Make a function descriptor for this function */
2931 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2932 S = allocateFunctionDesc(S + A);
2937 /* No, so look up the name in our global table. */
2938 symbol = strtab + sym.st_name;
2939 S_tmp = lookupSymbol( symbol );
2940 S = (Elf_Addr)S_tmp;
2942 #ifdef ELF_FUNCTION_DESC
2943 /* If a function, already a function descriptor - we would
2944 have to copy it to add an offset. */
2945 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2946 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2950 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
2953 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
2956 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
2957 (void*)P, (void*)S, (void*)A ));
2958 /* checkProddableBlock ( oc, (void*)P ); */
2962 switch (ELF_R_TYPE(info)) {
2963 # if defined(sparc_HOST_ARCH)
2964 case R_SPARC_WDISP30:
2965 w1 = *pP & 0xC0000000;
2966 w2 = (Elf_Word)((value - P) >> 2);
2967 ASSERT((w2 & 0xC0000000) == 0);
2972 w1 = *pP & 0xFFC00000;
2973 w2 = (Elf_Word)(value >> 10);
2974 ASSERT((w2 & 0xFFC00000) == 0);
2980 w2 = (Elf_Word)(value & 0x3FF);
2981 ASSERT((w2 & ~0x3FF) == 0);
2985 /* According to the Sun documentation:
2987 This relocation type resembles R_SPARC_32, except it refers to an
2988 unaligned word. That is, the word to be relocated must be treated
2989 as four separate bytes with arbitrary alignment, not as a word
2990 aligned according to the architecture requirements.
2992 (JRS: which means that freeloading on the R_SPARC_32 case
2993 is probably wrong, but hey ...)
2997 w2 = (Elf_Word)value;
3000 # elif defined(ia64_HOST_ARCH)
3001 case R_IA64_DIR64LSB:
3002 case R_IA64_FPTR64LSB:
3005 case R_IA64_PCREL64LSB:
3008 case R_IA64_SEGREL64LSB:
3009 addr = findElfSegment(ehdrC, value);
3012 case R_IA64_GPREL22:
3013 ia64_reloc_gprel22(P, value);
3015 case R_IA64_LTOFF22:
3016 case R_IA64_LTOFF22X:
3017 case R_IA64_LTOFF_FPTR22:
3018 addr = allocateGOTEntry(value);
3019 ia64_reloc_gprel22(P, addr);
3021 case R_IA64_PCREL21B:
3022 ia64_reloc_pcrel21(P, S, oc);
3025 /* This goes with R_IA64_LTOFF22X and points to the load to
3026 * convert into a move. We don't implement relaxation. */
3028 # elif defined(powerpc_HOST_ARCH)
3029 case R_PPC_ADDR16_LO:
3030 *(Elf32_Half*) P = value;
3033 case R_PPC_ADDR16_HI:
3034 *(Elf32_Half*) P = value >> 16;
3037 case R_PPC_ADDR16_HA:
3038 *(Elf32_Half*) P = (value + 0x8000) >> 16;
3042 *(Elf32_Word *) P = value;
3046 *(Elf32_Word *) P = value - P;
3052 if( delta << 6 >> 6 != delta )
3054 value = makeJumpIsland( oc, ELF_R_SYM(info), value );
3057 if( value == 0 || delta << 6 >> 6 != delta )
3059 barf( "Unable to make ppcJumpIsland for #%d",
3065 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3066 | (delta & 0x3fffffc);
3070 errorBelch("%s: unhandled ELF relocation(RelA) type %d\n",
3071 oc->fileName, ELF_R_TYPE(info));
3080 ocResolve_ELF ( ObjectCode* oc )
3084 Elf_Sym* stab = NULL;
3085 char* ehdrC = (char*)(oc->image);
3086 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
3087 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3089 /* first find "the" symbol table */
3090 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
3092 /* also go find the string table */
3093 strtab = findElfSection ( ehdrC, SHT_STRTAB );
3095 if (stab == NULL || strtab == NULL) {
3096 errorBelch("%s: can't find string or symbol table", oc->fileName);
3100 /* Process the relocation sections. */
3101 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
3102 if (shdr[shnum].sh_type == SHT_REL) {
3103 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
3104 shnum, stab, strtab );
3108 if (shdr[shnum].sh_type == SHT_RELA) {
3109 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
3110 shnum, stab, strtab );
3115 /* Free the local symbol table; we won't need it again. */
3116 freeHashTable(oc->lochash, NULL);
3119 #if defined(powerpc_HOST_ARCH)
3120 ocFlushInstructionCache( oc );
3128 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
3129 * at the front. The following utility functions pack and unpack instructions, and
3130 * take care of the most common relocations.
3133 #ifdef ia64_HOST_ARCH
3136 ia64_extract_instruction(Elf64_Xword *target)
3139 int slot = (Elf_Addr)target & 3;
3140 (Elf_Addr)target &= ~3;
3148 return ((w1 >> 5) & 0x1ffffffffff);
3150 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
3154 barf("ia64_extract_instruction: invalid slot %p", target);
3159 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
3161 int slot = (Elf_Addr)target & 3;
3162 (Elf_Addr)target &= ~3;
3167 *target |= value << 5;
3170 *target |= value << 46;
3171 *(target+1) |= value >> 18;
3174 *(target+1) |= value << 23;
3180 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3182 Elf64_Xword instruction;
3183 Elf64_Sxword rel_value;
3185 rel_value = value - gp_val;
3186 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3187 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3189 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3190 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3191 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3192 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3193 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3194 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3198 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3200 Elf64_Xword instruction;
3201 Elf64_Sxword rel_value;
3204 entry = allocatePLTEntry(value, oc);
3206 rel_value = (entry >> 4) - (target >> 4);
3207 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3208 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3210 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3211 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3212 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3213 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3219 * PowerPC ELF specifics
3222 #ifdef powerpc_HOST_ARCH
3224 static int ocAllocateJumpIslands_ELF( ObjectCode *oc )
3230 ehdr = (Elf_Ehdr *) oc->image;
3231 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
3233 for( i = 0; i < ehdr->e_shnum; i++ )
3234 if( shdr[i].sh_type == SHT_SYMTAB )
3237 if( i == ehdr->e_shnum )
3239 errorBelch( "This ELF file contains no symtab" );
3243 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
3245 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
3246 shdr[i].sh_entsize, sizeof( Elf_Sym ) );
3251 return ocAllocateJumpIslands( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
3254 #endif /* powerpc */
3258 /* --------------------------------------------------------------------------
3260 * ------------------------------------------------------------------------*/
3262 #if defined(OBJFORMAT_MACHO)
3265 Support for MachO linking on Darwin/MacOS X on PowerPC chips
3266 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3268 I hereby formally apologize for the hackish nature of this code.
3269 Things that need to be done:
3270 *) implement ocVerifyImage_MachO
3271 *) add still more sanity checks.
3274 static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
3276 struct mach_header *header = (struct mach_header *) oc->image;
3277 struct load_command *lc = (struct load_command *) (header + 1);
3280 for( i = 0; i < header->ncmds; i++ )
3282 if( lc->cmd == LC_SYMTAB )
3284 // Find out the first and last undefined external
3285 // symbol, so we don't have to allocate too many
3287 struct symtab_command *symLC = (struct symtab_command *) lc;
3288 int min = symLC->nsyms, max = 0;
3289 struct nlist *nlist =
3290 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
3292 for(i=0;i<symLC->nsyms;i++)
3294 if(nlist[i].n_type & N_STAB)
3296 else if(nlist[i].n_type & N_EXT)
3298 if((nlist[i].n_type & N_TYPE) == N_UNDF
3299 && (nlist[i].n_value == 0))
3309 return ocAllocateJumpIslands(oc, max - min + 1, min);
3314 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3316 return ocAllocateJumpIslands(oc,0,0);
3319 static int ocVerifyImage_MachO(ObjectCode* oc)
3321 // FIXME: do some verifying here
3325 static int resolveImports(
3328 struct symtab_command *symLC,
3329 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3330 unsigned long *indirectSyms,
3331 struct nlist *nlist)
3335 for(i=0;i*4<sect->size;i++)
3337 // according to otool, reserved1 contains the first index into the indirect symbol table
3338 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3339 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3342 if((symbol->n_type & N_TYPE) == N_UNDF
3343 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3344 addr = (void*) (symbol->n_value);
3345 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3348 addr = lookupSymbol(nm);
3351 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3355 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3356 ((void**)(image + sect->offset))[i] = addr;
3362 static char* relocateAddress(
3365 struct section* sections,
3366 unsigned long address)
3369 for(i = 0; i < nSections; i++)
3371 if(sections[i].addr <= address
3372 && address < sections[i].addr + sections[i].size)
3374 return oc->image + sections[i].offset + address - sections[i].addr;
3377 barf("Invalid Mach-O file:"
3378 "Address out of bounds while relocating object file");
3382 static int relocateSection(
3385 struct symtab_command *symLC, struct nlist *nlist,
3386 int nSections, struct section* sections, struct section *sect)
3388 struct relocation_info *relocs;
3391 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3393 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3397 relocs = (struct relocation_info*) (image + sect->reloff);
3401 if(relocs[i].r_address & R_SCATTERED)
3403 struct scattered_relocation_info *scat =
3404 (struct scattered_relocation_info*) &relocs[i];
3408 if(scat->r_length == 2)
3410 unsigned long word = 0;
3411 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
3412 checkProddableBlock(oc,wordPtr);
3414 // Step 1: Figure out what the relocated value should be
3415 if(scat->r_type == GENERIC_RELOC_VANILLA)
3417 word = *wordPtr + (unsigned long) relocateAddress(
3424 else if(scat->r_type == PPC_RELOC_SECTDIFF
3425 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
3426 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
3427 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3429 struct scattered_relocation_info *pair =
3430 (struct scattered_relocation_info*) &relocs[i+1];
3432 if(!pair->r_scattered || pair->r_type != PPC_RELOC_PAIR)
3433 barf("Invalid Mach-O file: "
3434 "PPC_RELOC_*_SECTDIFF not followed by PPC_RELOC_PAIR");
3436 word = (unsigned long)
3437 (relocateAddress(oc, nSections, sections, scat->r_value)
3438 - relocateAddress(oc, nSections, sections, pair->r_value));
3441 else if(scat->r_type == PPC_RELOC_HI16
3442 || scat->r_type == PPC_RELOC_LO16
3443 || scat->r_type == PPC_RELOC_HA16
3444 || scat->r_type == PPC_RELOC_LO14)
3445 { // these are generated by label+offset things
3446 struct relocation_info *pair = &relocs[i+1];
3447 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
3448 barf("Invalid Mach-O file: "
3449 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
3451 if(scat->r_type == PPC_RELOC_LO16)
3453 word = ((unsigned short*) wordPtr)[1];
3454 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3456 else if(scat->r_type == PPC_RELOC_LO14)
3458 barf("Unsupported Relocation: PPC_RELOC_LO14");
3459 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
3460 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3462 else if(scat->r_type == PPC_RELOC_HI16)
3464 word = ((unsigned short*) wordPtr)[1] << 16;
3465 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3467 else if(scat->r_type == PPC_RELOC_HA16)
3469 word = ((unsigned short*) wordPtr)[1] << 16;
3470 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3474 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
3480 continue; // ignore the others
3482 if(scat->r_type == GENERIC_RELOC_VANILLA
3483 || scat->r_type == PPC_RELOC_SECTDIFF)
3487 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
3489 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3491 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
3493 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3495 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
3497 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3498 + ((word & (1<<15)) ? 1 : 0);
3503 continue; // FIXME: I hope it's OK to ignore all the others.
3507 struct relocation_info *reloc = &relocs[i];
3508 if(reloc->r_pcrel && !reloc->r_extern)
3511 if(reloc->r_length == 2)
3513 unsigned long word = 0;
3514 unsigned long jumpIsland = 0;
3515 long offsetToJumpIsland;
3517 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3518 checkProddableBlock(oc,wordPtr);
3520 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3524 else if(reloc->r_type == PPC_RELOC_LO16)
3526 word = ((unsigned short*) wordPtr)[1];
3527 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3529 else if(reloc->r_type == PPC_RELOC_HI16)
3531 word = ((unsigned short*) wordPtr)[1] << 16;
3532 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3534 else if(reloc->r_type == PPC_RELOC_HA16)
3536 word = ((unsigned short*) wordPtr)[1] << 16;
3537 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3539 else if(reloc->r_type == PPC_RELOC_BR24)
3542 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
3546 if(!reloc->r_extern)
3549 sections[reloc->r_symbolnum-1].offset
3550 - sections[reloc->r_symbolnum-1].addr
3557 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3558 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3559 unsigned long symbolAddress = (unsigned long) (lookupSymbol(nm));
3562 errorBelch("\nunknown symbol `%s'", nm);
3568 // In the .o file, this should be a relative jump to NULL
3569 // and we'll change it to a jump to a relative jump to the symbol
3570 ASSERT(-word == reloc->r_address);
3571 word = symbolAddress;
3572 jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,word);
3573 word -= ((long)image) + sect->offset + reloc->r_address;
3576 offsetToJumpIsland = jumpIsland
3577 - (((long)image) + sect->offset + reloc->r_address);
3582 word += symbolAddress;
3586 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3591 else if(reloc->r_type == PPC_RELOC_LO16)
3593 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3596 else if(reloc->r_type == PPC_RELOC_HI16)
3598 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3601 else if(reloc->r_type == PPC_RELOC_HA16)
3603 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3604 + ((word & (1<<15)) ? 1 : 0);
3607 else if(reloc->r_type == PPC_RELOC_BR24)
3609 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3611 // The branch offset is too large.
3612 // Therefore, we try to use a jump island.
3615 barf("unconditional relative branch out of range: "
3616 "no jump island available");
3619 word = offsetToJumpIsland;
3620 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3621 barf("unconditional relative branch out of range: "
3622 "jump island out of range");
3624 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3628 barf("\nunknown relocation %d",reloc->r_type);
3635 static int ocGetNames_MachO(ObjectCode* oc)
3637 char *image = (char*) oc->image;
3638 struct mach_header *header = (struct mach_header*) image;
3639 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3640 unsigned i,curSymbol;
3641 struct segment_command *segLC = NULL;
3642 struct section *sections;
3643 struct symtab_command *symLC = NULL;
3644 struct nlist *nlist;
3645 unsigned long commonSize = 0;
3646 char *commonStorage = NULL;
3647 unsigned long commonCounter;
3649 for(i=0;i<header->ncmds;i++)
3651 if(lc->cmd == LC_SEGMENT)
3652 segLC = (struct segment_command*) lc;
3653 else if(lc->cmd == LC_SYMTAB)
3654 symLC = (struct symtab_command*) lc;
3655 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3658 sections = (struct section*) (segLC+1);
3659 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
3662 for(i=0;i<segLC->nsects;i++)
3664 if(sections[i].size == 0)
3667 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
3669 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
3670 "ocGetNames_MachO(common symbols)");
3671 sections[i].offset = zeroFillArea - image;
3674 if(!strcmp(sections[i].sectname,"__text"))
3675 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3676 (void*) (image + sections[i].offset),
3677 (void*) (image + sections[i].offset + sections[i].size));
3678 else if(!strcmp(sections[i].sectname,"__const"))
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,"__data"))
3683 addSection(oc, SECTIONKIND_RWDATA,
3684 (void*) (image + sections[i].offset),
3685 (void*) (image + sections[i].offset + sections[i].size));
3686 else if(!strcmp(sections[i].sectname,"__bss")
3687 || !strcmp(sections[i].sectname,"__common"))
3688 addSection(oc, SECTIONKIND_RWDATA,
3689 (void*) (image + sections[i].offset),
3690 (void*) (image + sections[i].offset + sections[i].size));
3692 addProddableBlock(oc, (void*) (image + sections[i].offset),
3696 // count external symbols defined here
3700 for(i=0;i<symLC->nsyms;i++)
3702 if(nlist[i].n_type & N_STAB)
3704 else if(nlist[i].n_type & N_EXT)
3706 if((nlist[i].n_type & N_TYPE) == N_UNDF
3707 && (nlist[i].n_value != 0))
3709 commonSize += nlist[i].n_value;
3712 else if((nlist[i].n_type & N_TYPE) == N_SECT)
3717 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3718 "ocGetNames_MachO(oc->symbols)");
3723 for(i=0;i<symLC->nsyms;i++)
3725 if(nlist[i].n_type & N_STAB)
3727 else if((nlist[i].n_type & N_TYPE) == N_SECT)
3729 if(nlist[i].n_type & N_EXT)
3731 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3732 ghciInsertStrHashTable(oc->fileName, symhash, nm,
3734 + sections[nlist[i].n_sect-1].offset
3735 - sections[nlist[i].n_sect-1].addr
3736 + nlist[i].n_value);
3737 oc->symbols[curSymbol++] = nm;
3741 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3742 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm,
3744 + sections[nlist[i].n_sect-1].offset
3745 - sections[nlist[i].n_sect-1].addr
3746 + nlist[i].n_value);
3752 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3753 commonCounter = (unsigned long)commonStorage;
3756 for(i=0;i<symLC->nsyms;i++)
3758 if((nlist[i].n_type & N_TYPE) == N_UNDF
3759 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3761 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3762 unsigned long sz = nlist[i].n_value;
3764 nlist[i].n_value = commonCounter;
3766 ghciInsertStrHashTable(oc->fileName, symhash, nm,
3767 (void*)commonCounter);
3768 oc->symbols[curSymbol++] = nm;
3770 commonCounter += sz;
3777 static int ocResolve_MachO(ObjectCode* oc)
3779 char *image = (char*) oc->image;
3780 struct mach_header *header = (struct mach_header*) image;
3781 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3783 struct segment_command *segLC = NULL;
3784 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3785 struct symtab_command *symLC = NULL;
3786 struct dysymtab_command *dsymLC = NULL;
3787 struct nlist *nlist;
3789 for(i=0;i<header->ncmds;i++)
3791 if(lc->cmd == LC_SEGMENT)
3792 segLC = (struct segment_command*) lc;
3793 else if(lc->cmd == LC_SYMTAB)
3794 symLC = (struct symtab_command*) lc;
3795 else if(lc->cmd == LC_DYSYMTAB)
3796 dsymLC = (struct dysymtab_command*) lc;
3797 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3800 sections = (struct section*) (segLC+1);
3801 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
3804 for(i=0;i<segLC->nsects;i++)
3806 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3807 la_ptrs = §ions[i];
3808 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3809 nl_ptrs = §ions[i];
3814 unsigned long *indirectSyms
3815 = (unsigned long*) (image + dsymLC->indirectsymoff);
3818 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3821 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3825 for(i=0;i<segLC->nsects;i++)
3827 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
3831 /* Free the local symbol table; we won't need it again. */
3832 freeHashTable(oc->lochash, NULL);
3835 #if defined (powerpc_HOST_ARCH)
3836 ocFlushInstructionCache( oc );
3843 * The Mach-O object format uses leading underscores. But not everywhere.
3844 * There is a small number of runtime support functions defined in
3845 * libcc_dynamic.a whose name does not have a leading underscore.
3846 * As a consequence, we can't get their address from C code.
3847 * We have to use inline assembler just to take the address of a function.
3851 static void machoInitSymbolsWithoutUnderscore()
3853 extern void* symbolsWithoutUnderscore[];
3854 void **p = symbolsWithoutUnderscore;
3855 __asm__ volatile(".data\n_symbolsWithoutUnderscore:");
3859 __asm__ volatile(".long " # x);
3861 RTS_MACHO_NOUNDERLINE_SYMBOLS
3863 __asm__ volatile(".text");
3867 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
3869 RTS_MACHO_NOUNDERLINE_SYMBOLS