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"
25 #include "StoragePriv.h"
28 #ifdef HAVE_SYS_TYPES_H
29 #include <sys/types.h>
35 #ifdef HAVE_SYS_STAT_H
39 #if defined(HAVE_FRAMEWORK_HASKELLSUPPORT)
40 #include <HaskellSupport/dlfcn.h>
41 #elif defined(HAVE_DLFCN_H)
45 #if defined(cygwin32_TARGET_OS)
50 #ifdef HAVE_SYS_TIME_H
54 #include <sys/fcntl.h>
55 #include <sys/termios.h>
56 #include <sys/utime.h>
57 #include <sys/utsname.h>
61 #if defined(ia64_TARGET_ARCH) || defined(openbsd_TARGET_OS)
66 #if defined(openbsd_TARGET_OS)
74 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS) || defined(openbsd_TARGET_OS)
75 # define OBJFORMAT_ELF
76 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
77 # define OBJFORMAT_PEi386
80 #elif defined(darwin_TARGET_OS)
81 # include <mach-o/ppc/reloc.h>
82 # define OBJFORMAT_MACHO
83 # include <mach-o/loader.h>
84 # include <mach-o/nlist.h>
85 # include <mach-o/reloc.h>
86 # include <mach-o/dyld.h>
89 /* Hash table mapping symbol names to Symbol */
90 static /*Str*/HashTable *symhash;
92 /* List of currently loaded objects */
93 ObjectCode *objects = NULL; /* initially empty */
95 #if defined(OBJFORMAT_ELF)
96 static int ocVerifyImage_ELF ( ObjectCode* oc );
97 static int ocGetNames_ELF ( ObjectCode* oc );
98 static int ocResolve_ELF ( ObjectCode* oc );
99 #elif defined(OBJFORMAT_PEi386)
100 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
101 static int ocGetNames_PEi386 ( ObjectCode* oc );
102 static int ocResolve_PEi386 ( ObjectCode* oc );
103 #elif defined(OBJFORMAT_MACHO)
104 static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
105 static int ocVerifyImage_MachO ( ObjectCode* oc );
106 static int ocGetNames_MachO ( ObjectCode* oc );
107 static int ocResolve_MachO ( ObjectCode* oc );
109 static void machoInitSymbolsWithoutUnderscore( void );
112 /* -----------------------------------------------------------------------------
113 * Built-in symbols from the RTS
116 typedef struct _RtsSymbolVal {
123 #define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
125 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
126 SymX(makeStableNamezh_fast) \
127 SymX(finalizzeWeakzh_fast)
129 /* These are not available in GUM!!! -- HWL */
130 #define Maybe_ForeignObj
131 #define Maybe_Stable_Names
134 #if !defined (mingw32_TARGET_OS)
135 #define RTS_POSIX_ONLY_SYMBOLS \
136 SymX(stg_sig_install) \
140 #if defined (cygwin32_TARGET_OS)
141 #define RTS_MINGW_ONLY_SYMBOLS /**/
142 /* Don't have the ability to read import libs / archives, so
143 * we have to stupidly list a lot of what libcygwin.a
146 #define RTS_CYGWIN_ONLY_SYMBOLS \
224 #elif !defined(mingw32_TARGET_OS)
225 #define RTS_MINGW_ONLY_SYMBOLS /**/
226 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
227 #else /* defined(mingw32_TARGET_OS) */
228 #define RTS_POSIX_ONLY_SYMBOLS /**/
229 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
231 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
233 #define RTS_MINGW_EXTRA_SYMS \
234 Sym(_imp____mb_cur_max) \
237 #define RTS_MINGW_EXTRA_SYMS
240 /* These are statically linked from the mingw libraries into the ghc
241 executable, so we have to employ this hack. */
242 #define RTS_MINGW_ONLY_SYMBOLS \
243 SymX(asyncReadzh_fast) \
244 SymX(asyncWritezh_fast) \
245 SymX(asyncDoProczh_fast) \
257 SymX(getservbyname) \
258 SymX(getservbyport) \
259 SymX(getprotobynumber) \
260 SymX(getprotobyname) \
261 SymX(gethostbyname) \
262 SymX(gethostbyaddr) \
297 Sym(_imp___timezone) \
305 RTS_MINGW_EXTRA_SYMS \
310 # define MAIN_CAP_SYM SymX(MainCapability)
312 # define MAIN_CAP_SYM
315 #define RTS_SYMBOLS \
319 SymX(stg_enter_info) \
320 SymX(stg_enter_ret) \
321 SymX(stg_gc_void_info) \
322 SymX(__stg_gc_enter_1) \
323 SymX(stg_gc_noregs) \
324 SymX(stg_gc_unpt_r1_info) \
325 SymX(stg_gc_unpt_r1) \
326 SymX(stg_gc_unbx_r1_info) \
327 SymX(stg_gc_unbx_r1) \
328 SymX(stg_gc_f1_info) \
330 SymX(stg_gc_d1_info) \
332 SymX(stg_gc_l1_info) \
335 SymX(stg_gc_fun_info) \
336 SymX(stg_gc_fun_ret) \
338 SymX(stg_gc_gen_info) \
339 SymX(stg_gc_gen_hp) \
341 SymX(stg_gen_yield) \
342 SymX(stg_yield_noregs) \
343 SymX(stg_yield_to_interpreter) \
344 SymX(stg_gen_block) \
345 SymX(stg_block_noregs) \
347 SymX(stg_block_takemvar) \
348 SymX(stg_block_putmvar) \
349 SymX(stg_seq_frame_info) \
351 SymX(MallocFailHook) \
353 SymX(OutOfHeapHook) \
354 SymX(StackOverflowHook) \
355 SymX(__encodeDouble) \
356 SymX(__encodeFloat) \
359 SymX(__gmpz_cmp_si) \
360 SymX(__gmpz_cmp_ui) \
361 SymX(__gmpz_get_si) \
362 SymX(__gmpz_get_ui) \
363 SymX(__int_encodeDouble) \
364 SymX(__int_encodeFloat) \
365 SymX(andIntegerzh_fast) \
367 SymX(blockAsyncExceptionszh_fast) \
370 SymX(complementIntegerzh_fast) \
371 SymX(cmpIntegerzh_fast) \
372 SymX(cmpIntegerIntzh_fast) \
373 SymX(createAdjustor) \
374 SymX(decodeDoublezh_fast) \
375 SymX(decodeFloatzh_fast) \
378 SymX(deRefWeakzh_fast) \
379 SymX(deRefStablePtrzh_fast) \
380 SymX(divExactIntegerzh_fast) \
381 SymX(divModIntegerzh_fast) \
384 SymX(forkOS_createThread) \
385 SymX(freeHaskellFunctionPtr) \
386 SymX(freeStablePtr) \
387 SymX(gcdIntegerzh_fast) \
388 SymX(gcdIntegerIntzh_fast) \
389 SymX(gcdIntzh_fast) \
393 SymX(int2Integerzh_fast) \
394 SymX(integer2Intzh_fast) \
395 SymX(integer2Wordzh_fast) \
396 SymX(isCurrentThreadBoundzh_fast) \
397 SymX(isDoubleDenormalized) \
398 SymX(isDoubleInfinite) \
400 SymX(isDoubleNegativeZero) \
401 SymX(isEmptyMVarzh_fast) \
402 SymX(isFloatDenormalized) \
403 SymX(isFloatInfinite) \
405 SymX(isFloatNegativeZero) \
406 SymX(killThreadzh_fast) \
407 SymX(makeStablePtrzh_fast) \
408 SymX(minusIntegerzh_fast) \
409 SymX(mkApUpd0zh_fast) \
410 SymX(myThreadIdzh_fast) \
411 SymX(labelThreadzh_fast) \
412 SymX(newArrayzh_fast) \
413 SymX(newBCOzh_fast) \
414 SymX(newByteArrayzh_fast) \
415 SymX_redirect(newCAF, newDynCAF) \
416 SymX(newMVarzh_fast) \
417 SymX(newMutVarzh_fast) \
418 SymX(atomicModifyMutVarzh_fast) \
419 SymX(newPinnedByteArrayzh_fast) \
420 SymX(orIntegerzh_fast) \
422 SymX(performMajorGC) \
423 SymX(plusIntegerzh_fast) \
426 SymX(putMVarzh_fast) \
427 SymX(quotIntegerzh_fast) \
428 SymX(quotRemIntegerzh_fast) \
430 SymX(raiseIOzh_fast) \
431 SymX(remIntegerzh_fast) \
432 SymX(resetNonBlockingFd) \
435 SymX(rts_checkSchedStatus) \
438 SymX(rts_evalLazyIO) \
439 SymX(rts_evalStableIO) \
443 SymX(rts_getDouble) \
448 SymX(rts_getFunPtr) \
449 SymX(rts_getStablePtr) \
450 SymX(rts_getThreadId) \
452 SymX(rts_getWord32) \
465 SymX(rts_mkStablePtr) \
473 SymX(rtsSupportsBoundThreads) \
475 SymX(__hscore_get_saved_termios) \
476 SymX(__hscore_set_saved_termios) \
478 SymX(startupHaskell) \
479 SymX(shutdownHaskell) \
480 SymX(shutdownHaskellAndExit) \
481 SymX(stable_ptr_table) \
482 SymX(stackOverflow) \
483 SymX(stg_CAF_BLACKHOLE_info) \
484 SymX(stg_BLACKHOLE_BQ_info) \
485 SymX(awakenBlockedQueue) \
486 SymX(stg_CHARLIKE_closure) \
487 SymX(stg_EMPTY_MVAR_info) \
488 SymX(stg_IND_STATIC_info) \
489 SymX(stg_INTLIKE_closure) \
490 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
491 SymX(stg_WEAK_info) \
492 SymX(stg_ap_v_info) \
493 SymX(stg_ap_f_info) \
494 SymX(stg_ap_d_info) \
495 SymX(stg_ap_l_info) \
496 SymX(stg_ap_n_info) \
497 SymX(stg_ap_p_info) \
498 SymX(stg_ap_pv_info) \
499 SymX(stg_ap_pp_info) \
500 SymX(stg_ap_ppv_info) \
501 SymX(stg_ap_ppp_info) \
502 SymX(stg_ap_pppp_info) \
503 SymX(stg_ap_ppppp_info) \
504 SymX(stg_ap_pppppp_info) \
505 SymX(stg_ap_ppppppp_info) \
513 SymX(stg_ap_pv_ret) \
514 SymX(stg_ap_pp_ret) \
515 SymX(stg_ap_ppv_ret) \
516 SymX(stg_ap_ppp_ret) \
517 SymX(stg_ap_pppp_ret) \
518 SymX(stg_ap_ppppp_ret) \
519 SymX(stg_ap_pppppp_ret) \
520 SymX(stg_ap_ppppppp_ret) \
521 SymX(stg_ap_1_upd_info) \
522 SymX(stg_ap_2_upd_info) \
523 SymX(stg_ap_3_upd_info) \
524 SymX(stg_ap_4_upd_info) \
525 SymX(stg_ap_5_upd_info) \
526 SymX(stg_ap_6_upd_info) \
527 SymX(stg_ap_7_upd_info) \
528 SymX(stg_ap_8_upd_info) \
530 SymX(stg_sel_0_upd_info) \
531 SymX(stg_sel_10_upd_info) \
532 SymX(stg_sel_11_upd_info) \
533 SymX(stg_sel_12_upd_info) \
534 SymX(stg_sel_13_upd_info) \
535 SymX(stg_sel_14_upd_info) \
536 SymX(stg_sel_15_upd_info) \
537 SymX(stg_sel_1_upd_info) \
538 SymX(stg_sel_2_upd_info) \
539 SymX(stg_sel_3_upd_info) \
540 SymX(stg_sel_4_upd_info) \
541 SymX(stg_sel_5_upd_info) \
542 SymX(stg_sel_6_upd_info) \
543 SymX(stg_sel_7_upd_info) \
544 SymX(stg_sel_8_upd_info) \
545 SymX(stg_sel_9_upd_info) \
546 SymX(stg_upd_frame_info) \
547 SymX(suspendThread) \
548 SymX(takeMVarzh_fast) \
549 SymX(timesIntegerzh_fast) \
550 SymX(tryPutMVarzh_fast) \
551 SymX(tryTakeMVarzh_fast) \
552 SymX(unblockAsyncExceptionszh_fast) \
553 SymX(unsafeThawArrayzh_fast) \
554 SymX(waitReadzh_fast) \
555 SymX(waitWritezh_fast) \
556 SymX(word2Integerzh_fast) \
557 SymX(xorIntegerzh_fast) \
560 #ifdef SUPPORT_LONG_LONGS
561 #define RTS_LONG_LONG_SYMS \
562 SymX(int64ToIntegerzh_fast) \
563 SymX(word64ToIntegerzh_fast)
565 #define RTS_LONG_LONG_SYMS /* nothing */
568 // 64-bit support functions in libgcc.a
569 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
570 #define RTS_LIBGCC_SYMBOLS \
579 #elif defined(ia64_TARGET_ARCH)
580 #define RTS_LIBGCC_SYMBOLS \
588 #define RTS_LIBGCC_SYMBOLS
591 #ifdef darwin_TARGET_OS
592 // Symbols that don't have a leading underscore
593 // on Mac OS X. They have to receive special treatment,
594 // see machoInitSymbolsWithoutUnderscore()
595 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
600 /* entirely bogus claims about types of these symbols */
601 #define Sym(vvv) extern void vvv(void);
602 #define SymX(vvv) /**/
603 #define SymX_redirect(vvv,xxx) /**/
606 RTS_POSIX_ONLY_SYMBOLS
607 RTS_MINGW_ONLY_SYMBOLS
608 RTS_CYGWIN_ONLY_SYMBOLS
614 #ifdef LEADING_UNDERSCORE
615 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
617 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
620 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
622 #define SymX(vvv) Sym(vvv)
624 // SymX_redirect allows us to redirect references to one symbol to
625 // another symbol. See newCAF/newDynCAF for an example.
626 #define SymX_redirect(vvv,xxx) \
627 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
630 static RtsSymbolVal rtsSyms[] = {
633 RTS_POSIX_ONLY_SYMBOLS
634 RTS_MINGW_ONLY_SYMBOLS
635 RTS_CYGWIN_ONLY_SYMBOLS
637 { 0, 0 } /* sentinel */
640 /* -----------------------------------------------------------------------------
641 * Insert symbols into hash tables, checking for duplicates.
643 static void ghciInsertStrHashTable ( char* obj_name,
649 if (lookupHashTable(table, (StgWord)key) == NULL)
651 insertStrHashTable(table, (StgWord)key, data);
656 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
658 "whilst processing object file\n"
660 "This could be caused by:\n"
661 " * Loading two different object files which export the same symbol\n"
662 " * Specifying the same object file twice on the GHCi command line\n"
663 " * An incorrect `package.conf' entry, causing some object to be\n"
665 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
674 /* -----------------------------------------------------------------------------
675 * initialize the object linker
679 static int linker_init_done = 0 ;
681 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
682 static void *dl_prog_handle;
685 /* dlopen(NULL,..) doesn't work so we grab libc explicitly */
686 #if defined(openbsd_TARGET_OS)
687 static void *dl_libc_handle;
695 /* Make initLinker idempotent, so we can call it
696 before evey relevant operation; that means we
697 don't need to initialise the linker separately */
698 if (linker_init_done == 1) { return; } else {
699 linker_init_done = 1;
702 symhash = allocStrHashTable();
704 /* populate the symbol table with stuff from the RTS */
705 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
706 ghciInsertStrHashTable("(GHCi built-in symbols)",
707 symhash, sym->lbl, sym->addr);
709 # if defined(OBJFORMAT_MACHO)
710 machoInitSymbolsWithoutUnderscore();
713 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
714 # if defined(RTLD_DEFAULT)
715 dl_prog_handle = RTLD_DEFAULT;
717 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
718 # if defined(openbsd_TARGET_OS)
719 dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
721 # endif // RTLD_DEFAULT
725 /* -----------------------------------------------------------------------------
726 * Loading DLL or .so dynamic libraries
727 * -----------------------------------------------------------------------------
729 * Add a DLL from which symbols may be found. In the ELF case, just
730 * do RTLD_GLOBAL-style add, so no further messing around needs to
731 * happen in order that symbols in the loaded .so are findable --
732 * lookupSymbol() will subsequently see them by dlsym on the program's
733 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
735 * In the PEi386 case, open the DLLs and put handles to them in a
736 * linked list. When looking for a symbol, try all handles in the
737 * list. This means that we need to load even DLLs that are guaranteed
738 * to be in the ghc.exe image already, just so we can get a handle
739 * to give to loadSymbol, so that we can find the symbols. For such
740 * libraries, the LoadLibrary call should be a no-op except for returning
745 #if defined(OBJFORMAT_PEi386)
746 /* A record for storing handles into DLLs. */
751 struct _OpenedDLL* next;
756 /* A list thereof. */
757 static OpenedDLL* opened_dlls = NULL;
761 addDLL( char *dll_name )
763 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
764 /* ------------------- ELF DLL loader ------------------- */
770 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
773 /* dlopen failed; return a ptr to the error msg. */
775 if (errmsg == NULL) errmsg = "addDLL: unknown error";
782 # elif defined(OBJFORMAT_PEi386)
783 /* ------------------- Win32 DLL loader ------------------- */
791 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
793 /* See if we've already got it, and ignore if so. */
794 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
795 if (0 == strcmp(o_dll->name, dll_name))
799 /* The file name has no suffix (yet) so that we can try
800 both foo.dll and foo.drv
802 The documentation for LoadLibrary says:
803 If no file name extension is specified in the lpFileName
804 parameter, the default library extension .dll is
805 appended. However, the file name string can include a trailing
806 point character (.) to indicate that the module name has no
809 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
810 sprintf(buf, "%s.DLL", dll_name);
811 instance = LoadLibrary(buf);
812 if (instance == NULL) {
813 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
814 instance = LoadLibrary(buf);
815 if (instance == NULL) {
818 /* LoadLibrary failed; return a ptr to the error msg. */
819 return "addDLL: unknown error";
824 /* Add this DLL to the list of DLLs in which to search for symbols. */
825 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
826 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
827 strcpy(o_dll->name, dll_name);
828 o_dll->instance = instance;
829 o_dll->next = opened_dlls;
834 barf("addDLL: not implemented on this platform");
838 /* -----------------------------------------------------------------------------
839 * lookup a symbol in the hash table
842 lookupSymbol( char *lbl )
846 ASSERT(symhash != NULL);
847 val = lookupStrHashTable(symhash, lbl);
850 # if defined(OBJFORMAT_ELF)
851 # if defined(openbsd_TARGET_OS)
852 val = dlsym(dl_prog_handle, lbl);
853 return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
854 # else /* not openbsd */
855 return dlsym(dl_prog_handle, lbl);
857 # elif defined(OBJFORMAT_MACHO)
858 if(NSIsSymbolNameDefined(lbl)) {
859 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
860 return NSAddressOfSymbol(symbol);
864 # elif defined(OBJFORMAT_PEi386)
867 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
868 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
870 /* HACK: if the name has an initial underscore, try stripping
871 it off & look that up first. I've yet to verify whether there's
872 a Rule that governs whether an initial '_' *should always* be
873 stripped off when mapping from import lib name to the DLL name.
875 sym = GetProcAddress(o_dll->instance, (lbl+1));
877 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
881 sym = GetProcAddress(o_dll->instance, lbl);
883 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
898 __attribute((unused))
900 lookupLocalSymbol( ObjectCode* oc, char *lbl )
904 val = lookupStrHashTable(oc->lochash, lbl);
914 /* -----------------------------------------------------------------------------
915 * Debugging aid: look in GHCi's object symbol tables for symbols
916 * within DELTA bytes of the specified address, and show their names.
919 void ghci_enquire ( char* addr );
921 void ghci_enquire ( char* addr )
926 const int DELTA = 64;
931 for (oc = objects; oc; oc = oc->next) {
932 for (i = 0; i < oc->n_symbols; i++) {
933 sym = oc->symbols[i];
934 if (sym == NULL) continue;
935 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
937 if (oc->lochash != NULL) {
938 a = lookupStrHashTable(oc->lochash, sym);
941 a = lookupStrHashTable(symhash, sym);
944 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
946 else if (addr-DELTA <= a && a <= addr+DELTA) {
947 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
954 #ifdef ia64_TARGET_ARCH
955 static unsigned int PLTSize(void);
958 /* -----------------------------------------------------------------------------
959 * Load an obj (populate the global symbol table, but don't resolve yet)
961 * Returns: 1 if ok, 0 on error.
964 loadObj( char *path )
971 void *map_addr = NULL;
978 /* fprintf(stderr, "loadObj %s\n", path ); */
980 /* Check that we haven't already loaded this object. Don't give up
981 at this stage; ocGetNames_* will barf later. */
985 for (o = objects; o; o = o->next) {
986 if (0 == strcmp(o->fileName, path))
992 "GHCi runtime linker: warning: looks like you're trying to load the\n"
993 "same object file twice:\n"
995 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
1001 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1003 # if defined(OBJFORMAT_ELF)
1004 oc->formatName = "ELF";
1005 # elif defined(OBJFORMAT_PEi386)
1006 oc->formatName = "PEi386";
1007 # elif defined(OBJFORMAT_MACHO)
1008 oc->formatName = "Mach-O";
1011 barf("loadObj: not implemented on this platform");
1014 r = stat(path, &st);
1015 if (r == -1) { return 0; }
1017 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1018 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1019 strcpy(oc->fileName, path);
1021 oc->fileSize = st.st_size;
1023 oc->sections = NULL;
1024 oc->lochash = allocStrHashTable();
1025 oc->proddables = NULL;
1027 /* chain it onto the list of objects */
1032 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1034 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1036 #if defined(openbsd_TARGET_OS)
1037 fd = open(path, O_RDONLY, S_IRUSR);
1039 fd = open(path, O_RDONLY);
1042 barf("loadObj: can't open `%s'", path);
1044 pagesize = getpagesize();
1046 #ifdef ia64_TARGET_ARCH
1047 /* The PLT needs to be right before the object */
1048 n = ROUND_UP(PLTSize(), pagesize);
1049 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1050 if (oc->plt == MAP_FAILED)
1051 barf("loadObj: can't allocate PLT");
1054 map_addr = oc->plt + n;
1057 n = ROUND_UP(oc->fileSize, pagesize);
1058 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1059 if (oc->image == MAP_FAILED)
1060 barf("loadObj: can't map `%s'", path);
1064 #else /* !USE_MMAP */
1066 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1068 /* load the image into memory */
1069 f = fopen(path, "rb");
1071 barf("loadObj: can't read `%s'", path);
1073 n = fread ( oc->image, 1, oc->fileSize, f );
1074 if (n != oc->fileSize)
1075 barf("loadObj: error whilst reading `%s'", path);
1079 #endif /* USE_MMAP */
1081 # if defined(OBJFORMAT_MACHO)
1082 r = ocAllocateJumpIslands_MachO ( oc );
1083 if (!r) { return r; }
1086 /* verify the in-memory image */
1087 # if defined(OBJFORMAT_ELF)
1088 r = ocVerifyImage_ELF ( oc );
1089 # elif defined(OBJFORMAT_PEi386)
1090 r = ocVerifyImage_PEi386 ( oc );
1091 # elif defined(OBJFORMAT_MACHO)
1092 r = ocVerifyImage_MachO ( oc );
1094 barf("loadObj: no verify method");
1096 if (!r) { return r; }
1098 /* build the symbol list for this image */
1099 # if defined(OBJFORMAT_ELF)
1100 r = ocGetNames_ELF ( oc );
1101 # elif defined(OBJFORMAT_PEi386)
1102 r = ocGetNames_PEi386 ( oc );
1103 # elif defined(OBJFORMAT_MACHO)
1104 r = ocGetNames_MachO ( oc );
1106 barf("loadObj: no getNames method");
1108 if (!r) { return r; }
1110 /* loaded, but not resolved yet */
1111 oc->status = OBJECT_LOADED;
1116 /* -----------------------------------------------------------------------------
1117 * resolve all the currently unlinked objects in memory
1119 * Returns: 1 if ok, 0 on error.
1129 for (oc = objects; oc; oc = oc->next) {
1130 if (oc->status != OBJECT_RESOLVED) {
1131 # if defined(OBJFORMAT_ELF)
1132 r = ocResolve_ELF ( oc );
1133 # elif defined(OBJFORMAT_PEi386)
1134 r = ocResolve_PEi386 ( oc );
1135 # elif defined(OBJFORMAT_MACHO)
1136 r = ocResolve_MachO ( oc );
1138 barf("resolveObjs: not implemented on this platform");
1140 if (!r) { return r; }
1141 oc->status = OBJECT_RESOLVED;
1147 /* -----------------------------------------------------------------------------
1148 * delete an object from the pool
1151 unloadObj( char *path )
1153 ObjectCode *oc, *prev;
1155 ASSERT(symhash != NULL);
1156 ASSERT(objects != NULL);
1161 for (oc = objects; oc; prev = oc, oc = oc->next) {
1162 if (!strcmp(oc->fileName,path)) {
1164 /* Remove all the mappings for the symbols within this
1169 for (i = 0; i < oc->n_symbols; i++) {
1170 if (oc->symbols[i] != NULL) {
1171 removeStrHashTable(symhash, oc->symbols[i], NULL);
1179 prev->next = oc->next;
1182 /* We're going to leave this in place, in case there are
1183 any pointers from the heap into it: */
1184 /* stgFree(oc->image); */
1185 stgFree(oc->fileName);
1186 stgFree(oc->symbols);
1187 stgFree(oc->sections);
1188 /* The local hash table should have been freed at the end
1189 of the ocResolve_ call on it. */
1190 ASSERT(oc->lochash == NULL);
1196 belch("unloadObj: can't find `%s' to unload", path);
1200 /* -----------------------------------------------------------------------------
1201 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1202 * which may be prodded during relocation, and abort if we try and write
1203 * outside any of these.
1205 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1208 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1209 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1213 pb->next = oc->proddables;
1214 oc->proddables = pb;
1217 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1220 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1221 char* s = (char*)(pb->start);
1222 char* e = s + pb->size - 1;
1223 char* a = (char*)addr;
1224 /* Assumes that the biggest fixup involves a 4-byte write. This
1225 probably needs to be changed to 8 (ie, +7) on 64-bit
1227 if (a >= s && (a+3) <= e) return;
1229 barf("checkProddableBlock: invalid fixup in runtime linker");
1232 /* -----------------------------------------------------------------------------
1233 * Section management.
1235 static void addSection ( ObjectCode* oc, SectionKind kind,
1236 void* start, void* end )
1238 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1242 s->next = oc->sections;
1245 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1246 start, ((char*)end)-1, end - start + 1, kind );
1252 /* --------------------------------------------------------------------------
1253 * PEi386 specifics (Win32 targets)
1254 * ------------------------------------------------------------------------*/
1256 /* The information for this linker comes from
1257 Microsoft Portable Executable
1258 and Common Object File Format Specification
1259 revision 5.1 January 1998
1260 which SimonM says comes from the MS Developer Network CDs.
1262 It can be found there (on older CDs), but can also be found
1265 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1267 (this is Rev 6.0 from February 1999).
1269 Things move, so if that fails, try searching for it via
1271 http://www.google.com/search?q=PE+COFF+specification
1273 The ultimate reference for the PE format is the Winnt.h
1274 header file that comes with the Platform SDKs; as always,
1275 implementations will drift wrt their documentation.
1277 A good background article on the PE format is Matt Pietrek's
1278 March 1994 article in Microsoft System Journal (MSJ)
1279 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1280 Win32 Portable Executable File Format." The info in there
1281 has recently been updated in a two part article in
1282 MSDN magazine, issues Feb and March 2002,
1283 "Inside Windows: An In-Depth Look into the Win32 Portable
1284 Executable File Format"
1286 John Levine's book "Linkers and Loaders" contains useful
1291 #if defined(OBJFORMAT_PEi386)
1295 typedef unsigned char UChar;
1296 typedef unsigned short UInt16;
1297 typedef unsigned int UInt32;
1304 UInt16 NumberOfSections;
1305 UInt32 TimeDateStamp;
1306 UInt32 PointerToSymbolTable;
1307 UInt32 NumberOfSymbols;
1308 UInt16 SizeOfOptionalHeader;
1309 UInt16 Characteristics;
1313 #define sizeof_COFF_header 20
1320 UInt32 VirtualAddress;
1321 UInt32 SizeOfRawData;
1322 UInt32 PointerToRawData;
1323 UInt32 PointerToRelocations;
1324 UInt32 PointerToLinenumbers;
1325 UInt16 NumberOfRelocations;
1326 UInt16 NumberOfLineNumbers;
1327 UInt32 Characteristics;
1331 #define sizeof_COFF_section 40
1338 UInt16 SectionNumber;
1341 UChar NumberOfAuxSymbols;
1345 #define sizeof_COFF_symbol 18
1350 UInt32 VirtualAddress;
1351 UInt32 SymbolTableIndex;
1356 #define sizeof_COFF_reloc 10
1359 /* From PE spec doc, section 3.3.2 */
1360 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1361 windows.h -- for the same purpose, but I want to know what I'm
1363 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1364 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1365 #define MYIMAGE_FILE_DLL 0x2000
1366 #define MYIMAGE_FILE_SYSTEM 0x1000
1367 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1368 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1369 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1371 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1372 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1373 #define MYIMAGE_SYM_CLASS_STATIC 3
1374 #define MYIMAGE_SYM_UNDEFINED 0
1376 /* From PE spec doc, section 4.1 */
1377 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1378 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1379 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1381 /* From PE spec doc, section 5.2.1 */
1382 #define MYIMAGE_REL_I386_DIR32 0x0006
1383 #define MYIMAGE_REL_I386_REL32 0x0014
1386 /* We use myindex to calculate array addresses, rather than
1387 simply doing the normal subscript thing. That's because
1388 some of the above structs have sizes which are not
1389 a whole number of words. GCC rounds their sizes up to a
1390 whole number of words, which means that the address calcs
1391 arising from using normal C indexing or pointer arithmetic
1392 are just plain wrong. Sigh.
1395 myindex ( int scale, void* base, int index )
1398 ((UChar*)base) + scale * index;
1403 printName ( UChar* name, UChar* strtab )
1405 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1406 UInt32 strtab_offset = * (UInt32*)(name+4);
1407 fprintf ( stderr, "%s", strtab + strtab_offset );
1410 for (i = 0; i < 8; i++) {
1411 if (name[i] == 0) break;
1412 fprintf ( stderr, "%c", name[i] );
1419 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1421 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1422 UInt32 strtab_offset = * (UInt32*)(name+4);
1423 strncpy ( dst, strtab+strtab_offset, dstSize );
1429 if (name[i] == 0) break;
1439 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1442 /* If the string is longer than 8 bytes, look in the
1443 string table for it -- this will be correctly zero terminated.
1445 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1446 UInt32 strtab_offset = * (UInt32*)(name+4);
1447 return ((UChar*)strtab) + strtab_offset;
1449 /* Otherwise, if shorter than 8 bytes, return the original,
1450 which by defn is correctly terminated.
1452 if (name[7]==0) return name;
1453 /* The annoying case: 8 bytes. Copy into a temporary
1454 (which is never freed ...)
1456 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1458 strncpy(newstr,name,8);
1464 /* Just compares the short names (first 8 chars) */
1465 static COFF_section *
1466 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1470 = (COFF_header*)(oc->image);
1471 COFF_section* sectab
1473 ((UChar*)(oc->image))
1474 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1476 for (i = 0; i < hdr->NumberOfSections; i++) {
1479 COFF_section* section_i
1481 myindex ( sizeof_COFF_section, sectab, i );
1482 n1 = (UChar*) &(section_i->Name);
1484 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1485 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1486 n1[6]==n2[6] && n1[7]==n2[7])
1495 zapTrailingAtSign ( UChar* sym )
1497 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1499 if (sym[0] == 0) return;
1501 while (sym[i] != 0) i++;
1504 while (j > 0 && my_isdigit(sym[j])) j--;
1505 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1511 ocVerifyImage_PEi386 ( ObjectCode* oc )
1516 COFF_section* sectab;
1517 COFF_symbol* symtab;
1519 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1520 hdr = (COFF_header*)(oc->image);
1521 sectab = (COFF_section*) (
1522 ((UChar*)(oc->image))
1523 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1525 symtab = (COFF_symbol*) (
1526 ((UChar*)(oc->image))
1527 + hdr->PointerToSymbolTable
1529 strtab = ((UChar*)symtab)
1530 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1532 if (hdr->Machine != 0x14c) {
1533 belch("Not x86 PEi386");
1536 if (hdr->SizeOfOptionalHeader != 0) {
1537 belch("PEi386 with nonempty optional header");
1540 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1541 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1542 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1543 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1544 belch("Not a PEi386 object file");
1547 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1548 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1549 belch("Invalid PEi386 word size or endiannness: %d",
1550 (int)(hdr->Characteristics));
1553 /* If the string table size is way crazy, this might indicate that
1554 there are more than 64k relocations, despite claims to the
1555 contrary. Hence this test. */
1556 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1558 if ( (*(UInt32*)strtab) > 600000 ) {
1559 /* Note that 600k has no special significance other than being
1560 big enough to handle the almost-2MB-sized lumps that
1561 constitute HSwin32*.o. */
1562 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1567 /* No further verification after this point; only debug printing. */
1569 IF_DEBUG(linker, i=1);
1570 if (i == 0) return 1;
1573 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1575 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1577 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1579 fprintf ( stderr, "\n" );
1581 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1583 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1585 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1587 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1589 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1591 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1593 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1595 /* Print the section table. */
1596 fprintf ( stderr, "\n" );
1597 for (i = 0; i < hdr->NumberOfSections; i++) {
1599 COFF_section* sectab_i
1601 myindex ( sizeof_COFF_section, sectab, i );
1608 printName ( sectab_i->Name, strtab );
1618 sectab_i->VirtualSize,
1619 sectab_i->VirtualAddress,
1620 sectab_i->SizeOfRawData,
1621 sectab_i->PointerToRawData,
1622 sectab_i->NumberOfRelocations,
1623 sectab_i->PointerToRelocations,
1624 sectab_i->PointerToRawData
1626 reltab = (COFF_reloc*) (
1627 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1630 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1631 /* If the relocation field (a short) has overflowed, the
1632 * real count can be found in the first reloc entry.
1634 * See Section 4.1 (last para) of the PE spec (rev6.0).
1636 COFF_reloc* rel = (COFF_reloc*)
1637 myindex ( sizeof_COFF_reloc, reltab, 0 );
1638 noRelocs = rel->VirtualAddress;
1641 noRelocs = sectab_i->NumberOfRelocations;
1645 for (; j < noRelocs; j++) {
1647 COFF_reloc* rel = (COFF_reloc*)
1648 myindex ( sizeof_COFF_reloc, reltab, j );
1650 " type 0x%-4x vaddr 0x%-8x name `",
1652 rel->VirtualAddress );
1653 sym = (COFF_symbol*)
1654 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1655 /* Hmm..mysterious looking offset - what's it for? SOF */
1656 printName ( sym->Name, strtab -10 );
1657 fprintf ( stderr, "'\n" );
1660 fprintf ( stderr, "\n" );
1662 fprintf ( stderr, "\n" );
1663 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1664 fprintf ( stderr, "---START of string table---\n");
1665 for (i = 4; i < *(Int32*)strtab; i++) {
1667 fprintf ( stderr, "\n"); else
1668 fprintf( stderr, "%c", strtab[i] );
1670 fprintf ( stderr, "--- END of string table---\n");
1672 fprintf ( stderr, "\n" );
1675 COFF_symbol* symtab_i;
1676 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1677 symtab_i = (COFF_symbol*)
1678 myindex ( sizeof_COFF_symbol, symtab, i );
1684 printName ( symtab_i->Name, strtab );
1693 (Int32)(symtab_i->SectionNumber),
1694 (UInt32)symtab_i->Type,
1695 (UInt32)symtab_i->StorageClass,
1696 (UInt32)symtab_i->NumberOfAuxSymbols
1698 i += symtab_i->NumberOfAuxSymbols;
1702 fprintf ( stderr, "\n" );
1708 ocGetNames_PEi386 ( ObjectCode* oc )
1711 COFF_section* sectab;
1712 COFF_symbol* symtab;
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*)(oc->image))
1729 + hdr->PointerToSymbolTable
1730 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1732 /* Allocate space for any (local, anonymous) .bss sections. */
1734 for (i = 0; i < hdr->NumberOfSections; i++) {
1736 COFF_section* sectab_i
1738 myindex ( sizeof_COFF_section, sectab, i );
1739 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1740 if (sectab_i->VirtualSize == 0) continue;
1741 /* This is a non-empty .bss section. Allocate zeroed space for
1742 it, and set its PointerToRawData field such that oc->image +
1743 PointerToRawData == addr_of_zeroed_space. */
1744 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1745 "ocGetNames_PEi386(anonymous bss)");
1746 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1747 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1748 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1751 /* Copy section information into the ObjectCode. */
1753 for (i = 0; i < hdr->NumberOfSections; i++) {
1759 = SECTIONKIND_OTHER;
1760 COFF_section* sectab_i
1762 myindex ( sizeof_COFF_section, sectab, i );
1763 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1766 /* I'm sure this is the Right Way to do it. However, the
1767 alternative of testing the sectab_i->Name field seems to
1768 work ok with Cygwin.
1770 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1771 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1772 kind = SECTIONKIND_CODE_OR_RODATA;
1775 if (0==strcmp(".text",sectab_i->Name) ||
1776 0==strcmp(".rodata",sectab_i->Name))
1777 kind = SECTIONKIND_CODE_OR_RODATA;
1778 if (0==strcmp(".data",sectab_i->Name) ||
1779 0==strcmp(".bss",sectab_i->Name))
1780 kind = SECTIONKIND_RWDATA;
1782 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1783 sz = sectab_i->SizeOfRawData;
1784 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1786 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1787 end = start + sz - 1;
1789 if (kind == SECTIONKIND_OTHER
1790 /* Ignore sections called which contain stabs debugging
1792 && 0 != strcmp(".stab", sectab_i->Name)
1793 && 0 != strcmp(".stabstr", sectab_i->Name)
1795 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1799 if (kind != SECTIONKIND_OTHER && end >= start) {
1800 addSection(oc, kind, start, end);
1801 addProddableBlock(oc, start, end - start + 1);
1805 /* Copy exported symbols into the ObjectCode. */
1807 oc->n_symbols = hdr->NumberOfSymbols;
1808 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1809 "ocGetNames_PEi386(oc->symbols)");
1810 /* Call me paranoid; I don't care. */
1811 for (i = 0; i < oc->n_symbols; i++)
1812 oc->symbols[i] = NULL;
1816 COFF_symbol* symtab_i;
1817 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1818 symtab_i = (COFF_symbol*)
1819 myindex ( sizeof_COFF_symbol, symtab, i );
1823 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1824 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1825 /* This symbol is global and defined, viz, exported */
1826 /* for MYIMAGE_SYMCLASS_EXTERNAL
1827 && !MYIMAGE_SYM_UNDEFINED,
1828 the address of the symbol is:
1829 address of relevant section + offset in section
1831 COFF_section* sectabent
1832 = (COFF_section*) myindex ( sizeof_COFF_section,
1834 symtab_i->SectionNumber-1 );
1835 addr = ((UChar*)(oc->image))
1836 + (sectabent->PointerToRawData
1840 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1841 && symtab_i->Value > 0) {
1842 /* This symbol isn't in any section at all, ie, global bss.
1843 Allocate zeroed space for it. */
1844 addr = stgCallocBytes(1, symtab_i->Value,
1845 "ocGetNames_PEi386(non-anonymous bss)");
1846 addSection(oc, SECTIONKIND_RWDATA, addr,
1847 ((UChar*)addr) + symtab_i->Value - 1);
1848 addProddableBlock(oc, addr, symtab_i->Value);
1849 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1852 if (addr != NULL ) {
1853 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1854 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1855 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1856 ASSERT(i >= 0 && i < oc->n_symbols);
1857 /* cstring_from_COFF_symbol_name always succeeds. */
1858 oc->symbols[i] = sname;
1859 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1863 "IGNORING symbol %d\n"
1867 printName ( symtab_i->Name, strtab );
1876 (Int32)(symtab_i->SectionNumber),
1877 (UInt32)symtab_i->Type,
1878 (UInt32)symtab_i->StorageClass,
1879 (UInt32)symtab_i->NumberOfAuxSymbols
1884 i += symtab_i->NumberOfAuxSymbols;
1893 ocResolve_PEi386 ( ObjectCode* oc )
1896 COFF_section* sectab;
1897 COFF_symbol* symtab;
1907 /* ToDo: should be variable-sized? But is at least safe in the
1908 sense of buffer-overrun-proof. */
1910 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1912 hdr = (COFF_header*)(oc->image);
1913 sectab = (COFF_section*) (
1914 ((UChar*)(oc->image))
1915 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1917 symtab = (COFF_symbol*) (
1918 ((UChar*)(oc->image))
1919 + hdr->PointerToSymbolTable
1921 strtab = ((UChar*)(oc->image))
1922 + hdr->PointerToSymbolTable
1923 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1925 for (i = 0; i < hdr->NumberOfSections; i++) {
1926 COFF_section* sectab_i
1928 myindex ( sizeof_COFF_section, sectab, i );
1931 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1934 /* Ignore sections called which contain stabs debugging
1936 if (0 == strcmp(".stab", sectab_i->Name)
1937 || 0 == strcmp(".stabstr", sectab_i->Name))
1940 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1941 /* If the relocation field (a short) has overflowed, the
1942 * real count can be found in the first reloc entry.
1944 * See Section 4.1 (last para) of the PE spec (rev6.0).
1946 * Nov2003 update: the GNU linker still doesn't correctly
1947 * handle the generation of relocatable object files with
1948 * overflown relocations. Hence the output to warn of potential
1951 COFF_reloc* rel = (COFF_reloc*)
1952 myindex ( sizeof_COFF_reloc, reltab, 0 );
1953 noRelocs = rel->VirtualAddress;
1954 fprintf(stderr, "WARNING: Overflown relocation field (# relocs found: %u)\n", noRelocs); fflush(stderr);
1957 noRelocs = sectab_i->NumberOfRelocations;
1962 for (; j < noRelocs; j++) {
1964 COFF_reloc* reltab_j
1966 myindex ( sizeof_COFF_reloc, reltab, j );
1968 /* the location to patch */
1970 ((UChar*)(oc->image))
1971 + (sectab_i->PointerToRawData
1972 + reltab_j->VirtualAddress
1973 - sectab_i->VirtualAddress )
1975 /* the existing contents of pP */
1977 /* the symbol to connect to */
1978 sym = (COFF_symbol*)
1979 myindex ( sizeof_COFF_symbol,
1980 symtab, reltab_j->SymbolTableIndex );
1983 "reloc sec %2d num %3d: type 0x%-4x "
1984 "vaddr 0x%-8x name `",
1986 (UInt32)reltab_j->Type,
1987 reltab_j->VirtualAddress );
1988 printName ( sym->Name, strtab );
1989 fprintf ( stderr, "'\n" ));
1991 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1992 COFF_section* section_sym
1993 = findPEi386SectionCalled ( oc, sym->Name );
1995 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1998 S = ((UInt32)(oc->image))
1999 + (section_sym->PointerToRawData
2002 copyName ( sym->Name, strtab, symbol, 1000-1 );
2003 (void*)S = lookupLocalSymbol( oc, symbol );
2004 if ((void*)S != NULL) goto foundit;
2005 (void*)S = lookupSymbol( symbol );
2006 if ((void*)S != NULL) goto foundit;
2007 zapTrailingAtSign ( symbol );
2008 (void*)S = lookupLocalSymbol( oc, symbol );
2009 if ((void*)S != NULL) goto foundit;
2010 (void*)S = lookupSymbol( symbol );
2011 if ((void*)S != NULL) goto foundit;
2012 /* Newline first because the interactive linker has printed "linking..." */
2013 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2017 checkProddableBlock(oc, pP);
2018 switch (reltab_j->Type) {
2019 case MYIMAGE_REL_I386_DIR32:
2022 case MYIMAGE_REL_I386_REL32:
2023 /* Tricky. We have to insert a displacement at
2024 pP which, when added to the PC for the _next_
2025 insn, gives the address of the target (S).
2026 Problem is to know the address of the next insn
2027 when we only know pP. We assume that this
2028 literal field is always the last in the insn,
2029 so that the address of the next insn is pP+4
2030 -- hence the constant 4.
2031 Also I don't know if A should be added, but so
2032 far it has always been zero.
2035 *pP = S - ((UInt32)pP) - 4;
2038 belch("%s: unhandled PEi386 relocation type %d",
2039 oc->fileName, reltab_j->Type);
2046 IF_DEBUG(linker, belch("completed %s", oc->fileName));
2050 #endif /* defined(OBJFORMAT_PEi386) */
2053 /* --------------------------------------------------------------------------
2055 * ------------------------------------------------------------------------*/
2057 #if defined(OBJFORMAT_ELF)
2062 #if defined(sparc_TARGET_ARCH)
2063 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2064 #elif defined(i386_TARGET_ARCH)
2065 # define ELF_TARGET_386 /* Used inside <elf.h> */
2066 #elif defined(x86_64_TARGET_ARCH)
2067 # define ELF_TARGET_X64_64
2069 #elif defined (ia64_TARGET_ARCH)
2070 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2072 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2073 # define ELF_NEED_GOT /* needs Global Offset Table */
2074 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2077 #if !defined(openbsd_TARGET_OS)
2080 /* openbsd elf has things in different places, with diff names */
2081 #include <elf_abi.h>
2082 #include <machine/reloc.h>
2083 #define R_386_32 RELOC_32
2084 #define R_386_PC32 RELOC_PC32
2088 * Define a set of types which can be used for both ELF32 and ELF64
2092 #define ELFCLASS ELFCLASS64
2093 #define Elf_Addr Elf64_Addr
2094 #define Elf_Word Elf64_Word
2095 #define Elf_Sword Elf64_Sword
2096 #define Elf_Ehdr Elf64_Ehdr
2097 #define Elf_Phdr Elf64_Phdr
2098 #define Elf_Shdr Elf64_Shdr
2099 #define Elf_Sym Elf64_Sym
2100 #define Elf_Rel Elf64_Rel
2101 #define Elf_Rela Elf64_Rela
2102 #define ELF_ST_TYPE ELF64_ST_TYPE
2103 #define ELF_ST_BIND ELF64_ST_BIND
2104 #define ELF_R_TYPE ELF64_R_TYPE
2105 #define ELF_R_SYM ELF64_R_SYM
2107 #define ELFCLASS ELFCLASS32
2108 #define Elf_Addr Elf32_Addr
2109 #define Elf_Word Elf32_Word
2110 #define Elf_Sword Elf32_Sword
2111 #define Elf_Ehdr Elf32_Ehdr
2112 #define Elf_Phdr Elf32_Phdr
2113 #define Elf_Shdr Elf32_Shdr
2114 #define Elf_Sym Elf32_Sym
2115 #define Elf_Rel Elf32_Rel
2116 #define Elf_Rela Elf32_Rela
2118 #define ELF_ST_TYPE ELF32_ST_TYPE
2121 #define ELF_ST_BIND ELF32_ST_BIND
2124 #define ELF_R_TYPE ELF32_R_TYPE
2127 #define ELF_R_SYM ELF32_R_SYM
2133 * Functions to allocate entries in dynamic sections. Currently we simply
2134 * preallocate a large number, and we don't check if a entry for the given
2135 * target already exists (a linear search is too slow). Ideally these
2136 * entries would be associated with symbols.
2139 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2140 #define GOT_SIZE 0x20000
2141 #define FUNCTION_TABLE_SIZE 0x10000
2142 #define PLT_SIZE 0x08000
2145 static Elf_Addr got[GOT_SIZE];
2146 static unsigned int gotIndex;
2147 static Elf_Addr gp_val = (Elf_Addr)got;
2150 allocateGOTEntry(Elf_Addr target)
2154 if (gotIndex >= GOT_SIZE)
2155 barf("Global offset table overflow");
2157 entry = &got[gotIndex++];
2159 return (Elf_Addr)entry;
2163 #ifdef ELF_FUNCTION_DESC
2169 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2170 static unsigned int functionTableIndex;
2173 allocateFunctionDesc(Elf_Addr target)
2175 FunctionDesc *entry;
2177 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2178 barf("Function table overflow");
2180 entry = &functionTable[functionTableIndex++];
2182 entry->gp = (Elf_Addr)gp_val;
2183 return (Elf_Addr)entry;
2187 copyFunctionDesc(Elf_Addr target)
2189 FunctionDesc *olddesc = (FunctionDesc *)target;
2190 FunctionDesc *newdesc;
2192 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2193 newdesc->gp = olddesc->gp;
2194 return (Elf_Addr)newdesc;
2199 #ifdef ia64_TARGET_ARCH
2200 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2201 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2203 static unsigned char plt_code[] =
2205 /* taken from binutils bfd/elfxx-ia64.c */
2206 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2207 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2208 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2209 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2210 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2211 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2214 /* If we can't get to the function descriptor via gp, take a local copy of it */
2215 #define PLT_RELOC(code, target) { \
2216 Elf64_Sxword rel_value = target - gp_val; \
2217 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2218 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2220 ia64_reloc_gprel22((Elf_Addr)code, target); \
2225 unsigned char code[sizeof(plt_code)];
2229 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2231 PLTEntry *plt = (PLTEntry *)oc->plt;
2234 if (oc->pltIndex >= PLT_SIZE)
2235 barf("Procedure table overflow");
2237 entry = &plt[oc->pltIndex++];
2238 memcpy(entry->code, plt_code, sizeof(entry->code));
2239 PLT_RELOC(entry->code, target);
2240 return (Elf_Addr)entry;
2246 return (PLT_SIZE * sizeof(PLTEntry));
2252 * Generic ELF functions
2256 findElfSection ( void* objImage, Elf_Word sh_type )
2258 char* ehdrC = (char*)objImage;
2259 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2260 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2261 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2265 for (i = 0; i < ehdr->e_shnum; i++) {
2266 if (shdr[i].sh_type == sh_type
2267 /* Ignore the section header's string table. */
2268 && i != ehdr->e_shstrndx
2269 /* Ignore string tables named .stabstr, as they contain
2271 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2273 ptr = ehdrC + shdr[i].sh_offset;
2280 #if defined(ia64_TARGET_ARCH)
2282 findElfSegment ( void* objImage, Elf_Addr vaddr )
2284 char* ehdrC = (char*)objImage;
2285 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2286 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2287 Elf_Addr segaddr = 0;
2290 for (i = 0; i < ehdr->e_phnum; i++) {
2291 segaddr = phdr[i].p_vaddr;
2292 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2300 ocVerifyImage_ELF ( ObjectCode* oc )
2304 int i, j, nent, nstrtab, nsymtabs;
2308 char* ehdrC = (char*)(oc->image);
2309 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2311 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2312 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2313 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2314 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2315 belch("%s: not an ELF object", oc->fileName);
2319 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2320 belch("%s: unsupported ELF format", oc->fileName);
2324 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2325 IF_DEBUG(linker,belch( "Is little-endian" ));
2327 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2328 IF_DEBUG(linker,belch( "Is big-endian" ));
2330 belch("%s: unknown endiannness", oc->fileName);
2334 if (ehdr->e_type != ET_REL) {
2335 belch("%s: not a relocatable object (.o) file", oc->fileName);
2338 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2340 IF_DEBUG(linker,belch( "Architecture is " ));
2341 switch (ehdr->e_machine) {
2342 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2343 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2345 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2347 default: IF_DEBUG(linker,belch( "unknown" ));
2348 belch("%s: unknown architecture", oc->fileName);
2352 IF_DEBUG(linker,belch(
2353 "\nSection header table: start %d, n_entries %d, ent_size %d",
2354 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2356 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2358 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2360 if (ehdr->e_shstrndx == SHN_UNDEF) {
2361 belch("%s: no section header string table", oc->fileName);
2364 IF_DEBUG(linker,belch( "Section header string table is section %d",
2366 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2369 for (i = 0; i < ehdr->e_shnum; i++) {
2370 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2371 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2372 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2373 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2374 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2375 ehdrC + shdr[i].sh_offset,
2376 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2378 if (shdr[i].sh_type == SHT_REL) {
2379 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2380 } else if (shdr[i].sh_type == SHT_RELA) {
2381 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2383 IF_DEBUG(linker,fprintf(stderr," "));
2386 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2390 IF_DEBUG(linker,belch( "\nString tables" ));
2393 for (i = 0; i < ehdr->e_shnum; i++) {
2394 if (shdr[i].sh_type == SHT_STRTAB
2395 /* Ignore the section header's string table. */
2396 && i != ehdr->e_shstrndx
2397 /* Ignore string tables named .stabstr, as they contain
2399 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2401 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2402 strtab = ehdrC + shdr[i].sh_offset;
2407 belch("%s: no string tables, or too many", oc->fileName);
2412 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2413 for (i = 0; i < ehdr->e_shnum; i++) {
2414 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2415 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2417 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2418 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2419 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2421 shdr[i].sh_size % sizeof(Elf_Sym)
2423 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2424 belch("%s: non-integral number of symbol table entries", oc->fileName);
2427 for (j = 0; j < nent; j++) {
2428 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2429 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2430 (int)stab[j].st_shndx,
2431 (int)stab[j].st_size,
2432 (char*)stab[j].st_value ));
2434 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2435 switch (ELF_ST_TYPE(stab[j].st_info)) {
2436 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2437 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2438 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2439 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2440 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2441 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2443 IF_DEBUG(linker,fprintf(stderr, " " ));
2445 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2446 switch (ELF_ST_BIND(stab[j].st_info)) {
2447 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2448 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2449 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2450 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2452 IF_DEBUG(linker,fprintf(stderr, " " ));
2454 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2458 if (nsymtabs == 0) {
2459 belch("%s: didn't find any symbol tables", oc->fileName);
2468 ocGetNames_ELF ( ObjectCode* oc )
2473 char* ehdrC = (char*)(oc->image);
2474 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2475 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2476 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2478 ASSERT(symhash != NULL);
2481 belch("%s: no strtab", oc->fileName);
2486 for (i = 0; i < ehdr->e_shnum; i++) {
2487 /* Figure out what kind of section it is. Logic derived from
2488 Figure 1.14 ("Special Sections") of the ELF document
2489 ("Portable Formats Specification, Version 1.1"). */
2490 Elf_Shdr hdr = shdr[i];
2491 SectionKind kind = SECTIONKIND_OTHER;
2494 if (hdr.sh_type == SHT_PROGBITS
2495 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2496 /* .text-style section */
2497 kind = SECTIONKIND_CODE_OR_RODATA;
2500 if (hdr.sh_type == SHT_PROGBITS
2501 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2502 /* .data-style section */
2503 kind = SECTIONKIND_RWDATA;
2506 if (hdr.sh_type == SHT_PROGBITS
2507 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2508 /* .rodata-style section */
2509 kind = SECTIONKIND_CODE_OR_RODATA;
2512 if (hdr.sh_type == SHT_NOBITS
2513 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2514 /* .bss-style section */
2515 kind = SECTIONKIND_RWDATA;
2519 if (is_bss && shdr[i].sh_size > 0) {
2520 /* This is a non-empty .bss section. Allocate zeroed space for
2521 it, and set its .sh_offset field such that
2522 ehdrC + .sh_offset == addr_of_zeroed_space. */
2523 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2524 "ocGetNames_ELF(BSS)");
2525 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2527 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2528 zspace, shdr[i].sh_size);
2532 /* fill in the section info */
2533 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2534 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2535 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2536 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2539 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2541 /* copy stuff into this module's object symbol table */
2542 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2543 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2545 oc->n_symbols = nent;
2546 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2547 "ocGetNames_ELF(oc->symbols)");
2549 for (j = 0; j < nent; j++) {
2551 char isLocal = FALSE; /* avoids uninit-var warning */
2553 char* nm = strtab + stab[j].st_name;
2554 int secno = stab[j].st_shndx;
2556 /* Figure out if we want to add it; if so, set ad to its
2557 address. Otherwise leave ad == NULL. */
2559 if (secno == SHN_COMMON) {
2561 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2563 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2564 stab[j].st_size, nm);
2566 /* Pointless to do addProddableBlock() for this area,
2567 since the linker should never poke around in it. */
2570 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2571 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2573 /* and not an undefined symbol */
2574 && stab[j].st_shndx != SHN_UNDEF
2575 /* and not in a "special section" */
2576 && stab[j].st_shndx < SHN_LORESERVE
2578 /* and it's a not a section or string table or anything silly */
2579 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2580 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2581 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2584 /* Section 0 is the undefined section, hence > and not >=. */
2585 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2587 if (shdr[secno].sh_type == SHT_NOBITS) {
2588 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2589 stab[j].st_size, stab[j].st_value, nm);
2592 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2593 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2596 #ifdef ELF_FUNCTION_DESC
2597 /* dlsym() and the initialisation table both give us function
2598 * descriptors, so to be consistent we store function descriptors
2599 * in the symbol table */
2600 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2601 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2603 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2604 ad, oc->fileName, nm ));
2609 /* And the decision is ... */
2613 oc->symbols[j] = nm;
2616 /* Ignore entirely. */
2618 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2622 IF_DEBUG(linker,belch( "skipping `%s'",
2623 strtab + stab[j].st_name ));
2626 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2627 (int)ELF_ST_BIND(stab[j].st_info),
2628 (int)ELF_ST_TYPE(stab[j].st_info),
2629 (int)stab[j].st_shndx,
2630 strtab + stab[j].st_name
2633 oc->symbols[j] = NULL;
2642 /* Do ELF relocations which lack an explicit addend. All x86-linux
2643 relocations appear to be of this form. */
2645 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2646 Elf_Shdr* shdr, int shnum,
2647 Elf_Sym* stab, char* strtab )
2652 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2653 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2654 int target_shndx = shdr[shnum].sh_info;
2655 int symtab_shndx = shdr[shnum].sh_link;
2657 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2658 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2659 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2660 target_shndx, symtab_shndx ));
2662 for (j = 0; j < nent; j++) {
2663 Elf_Addr offset = rtab[j].r_offset;
2664 Elf_Addr info = rtab[j].r_info;
2666 Elf_Addr P = ((Elf_Addr)targ) + offset;
2667 Elf_Word* pP = (Elf_Word*)P;
2672 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2673 j, (void*)offset, (void*)info ));
2675 IF_DEBUG(linker,belch( " ZERO" ));
2678 Elf_Sym sym = stab[ELF_R_SYM(info)];
2679 /* First see if it is a local symbol. */
2680 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2681 /* Yes, so we can get the address directly from the ELF symbol
2683 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2685 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2686 + stab[ELF_R_SYM(info)].st_value);
2689 /* No, so look up the name in our global table. */
2690 symbol = strtab + sym.st_name;
2691 (void*)S = lookupSymbol( symbol );
2694 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2697 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2700 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2701 (void*)P, (void*)S, (void*)A ));
2702 checkProddableBlock ( oc, pP );
2706 switch (ELF_R_TYPE(info)) {
2707 # ifdef i386_TARGET_ARCH
2708 case R_386_32: *pP = value; break;
2709 case R_386_PC32: *pP = value - P; break;
2712 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2713 oc->fileName, ELF_R_TYPE(info));
2721 /* Do ELF relocations for which explicit addends are supplied.
2722 sparc-solaris relocations appear to be of this form. */
2724 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2725 Elf_Shdr* shdr, int shnum,
2726 Elf_Sym* stab, char* strtab )
2731 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2732 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2733 int target_shndx = shdr[shnum].sh_info;
2734 int symtab_shndx = shdr[shnum].sh_link;
2736 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2737 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2738 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2739 target_shndx, symtab_shndx ));
2741 for (j = 0; j < nent; j++) {
2742 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2743 /* This #ifdef only serves to avoid unused-var warnings. */
2744 Elf_Addr offset = rtab[j].r_offset;
2745 Elf_Addr P = targ + offset;
2747 Elf_Addr info = rtab[j].r_info;
2748 Elf_Addr A = rtab[j].r_addend;
2751 # if defined(sparc_TARGET_ARCH)
2752 Elf_Word* pP = (Elf_Word*)P;
2754 # elif defined(ia64_TARGET_ARCH)
2755 Elf64_Xword *pP = (Elf64_Xword *)P;
2759 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2760 j, (void*)offset, (void*)info,
2763 IF_DEBUG(linker,belch( " ZERO" ));
2766 Elf_Sym sym = stab[ELF_R_SYM(info)];
2767 /* First see if it is a local symbol. */
2768 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2769 /* Yes, so we can get the address directly from the ELF symbol
2771 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2773 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2774 + stab[ELF_R_SYM(info)].st_value);
2775 #ifdef ELF_FUNCTION_DESC
2776 /* Make a function descriptor for this function */
2777 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2778 S = allocateFunctionDesc(S + A);
2783 /* No, so look up the name in our global table. */
2784 symbol = strtab + sym.st_name;
2785 (void*)S = lookupSymbol( symbol );
2787 #ifdef ELF_FUNCTION_DESC
2788 /* If a function, already a function descriptor - we would
2789 have to copy it to add an offset. */
2790 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2791 belch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2795 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2798 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2801 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2802 (void*)P, (void*)S, (void*)A ));
2803 /* checkProddableBlock ( oc, (void*)P ); */
2807 switch (ELF_R_TYPE(info)) {
2808 # if defined(sparc_TARGET_ARCH)
2809 case R_SPARC_WDISP30:
2810 w1 = *pP & 0xC0000000;
2811 w2 = (Elf_Word)((value - P) >> 2);
2812 ASSERT((w2 & 0xC0000000) == 0);
2817 w1 = *pP & 0xFFC00000;
2818 w2 = (Elf_Word)(value >> 10);
2819 ASSERT((w2 & 0xFFC00000) == 0);
2825 w2 = (Elf_Word)(value & 0x3FF);
2826 ASSERT((w2 & ~0x3FF) == 0);
2830 /* According to the Sun documentation:
2832 This relocation type resembles R_SPARC_32, except it refers to an
2833 unaligned word. That is, the word to be relocated must be treated
2834 as four separate bytes with arbitrary alignment, not as a word
2835 aligned according to the architecture requirements.
2837 (JRS: which means that freeloading on the R_SPARC_32 case
2838 is probably wrong, but hey ...)
2842 w2 = (Elf_Word)value;
2845 # elif defined(ia64_TARGET_ARCH)
2846 case R_IA64_DIR64LSB:
2847 case R_IA64_FPTR64LSB:
2850 case R_IA64_PCREL64LSB:
2853 case R_IA64_SEGREL64LSB:
2854 addr = findElfSegment(ehdrC, value);
2857 case R_IA64_GPREL22:
2858 ia64_reloc_gprel22(P, value);
2860 case R_IA64_LTOFF22:
2861 case R_IA64_LTOFF22X:
2862 case R_IA64_LTOFF_FPTR22:
2863 addr = allocateGOTEntry(value);
2864 ia64_reloc_gprel22(P, addr);
2866 case R_IA64_PCREL21B:
2867 ia64_reloc_pcrel21(P, S, oc);
2870 /* This goes with R_IA64_LTOFF22X and points to the load to
2871 * convert into a move. We don't implement relaxation. */
2875 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2876 oc->fileName, ELF_R_TYPE(info));
2885 ocResolve_ELF ( ObjectCode* oc )
2889 Elf_Sym* stab = NULL;
2890 char* ehdrC = (char*)(oc->image);
2891 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2892 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2893 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2895 /* first find "the" symbol table */
2896 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2898 /* also go find the string table */
2899 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2901 if (stab == NULL || strtab == NULL) {
2902 belch("%s: can't find string or symbol table", oc->fileName);
2906 /* Process the relocation sections. */
2907 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2909 /* Skip sections called ".rel.stab". These appear to contain
2910 relocation entries that, when done, make the stabs debugging
2911 info point at the right places. We ain't interested in all
2913 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2916 if (shdr[shnum].sh_type == SHT_REL ) {
2917 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2918 shnum, stab, strtab );
2922 if (shdr[shnum].sh_type == SHT_RELA) {
2923 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2924 shnum, stab, strtab );
2929 /* Free the local symbol table; we won't need it again. */
2930 freeHashTable(oc->lochash, NULL);
2938 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2939 * at the front. The following utility functions pack and unpack instructions, and
2940 * take care of the most common relocations.
2943 #ifdef ia64_TARGET_ARCH
2946 ia64_extract_instruction(Elf64_Xword *target)
2949 int slot = (Elf_Addr)target & 3;
2950 (Elf_Addr)target &= ~3;
2958 return ((w1 >> 5) & 0x1ffffffffff);
2960 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2964 barf("ia64_extract_instruction: invalid slot %p", target);
2969 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2971 int slot = (Elf_Addr)target & 3;
2972 (Elf_Addr)target &= ~3;
2977 *target |= value << 5;
2980 *target |= value << 46;
2981 *(target+1) |= value >> 18;
2984 *(target+1) |= value << 23;
2990 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2992 Elf64_Xword instruction;
2993 Elf64_Sxword rel_value;
2995 rel_value = value - gp_val;
2996 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2997 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2999 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3000 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3001 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3002 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3003 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3004 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3008 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3010 Elf64_Xword instruction;
3011 Elf64_Sxword rel_value;
3014 entry = allocatePLTEntry(value, oc);
3016 rel_value = (entry >> 4) - (target >> 4);
3017 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3018 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3020 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3021 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3022 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3023 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3030 /* --------------------------------------------------------------------------
3032 * ------------------------------------------------------------------------*/
3034 #if defined(OBJFORMAT_MACHO)
3037 Support for MachO linking on Darwin/MacOS X on PowerPC chips
3038 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3040 I hereby formally apologize for the hackish nature of this code.
3041 Things that need to be done:
3042 *) implement ocVerifyImage_MachO
3043 *) add still more sanity checks.
3048 ocAllocateJumpIslands_MachO
3050 Allocate additional space at the end of the object file image to make room
3053 PowerPC relative branch instructions have a 24 bit displacement field.
3054 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
3055 If a particular imported symbol is outside this range, we have to redirect
3056 the jump to a short piece of new code that just loads the 32bit absolute
3057 address and jumps there.
3058 This function just allocates space for one 16 byte jump island for every
3059 undefined symbol in the object file. The code for the islands is filled in by
3060 makeJumpIsland below.
3063 static const int islandSize = 16;
3065 static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
3067 char *image = (char*) oc->image;
3068 struct mach_header *header = (struct mach_header*) image;
3069 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3072 for(i=0;i<header->ncmds;i++)
3074 if(lc->cmd == LC_DYSYMTAB)
3076 struct dysymtab_command *dsymLC = (struct dysymtab_command*) lc;
3077 unsigned long nundefsym = dsymLC->nundefsym;
3078 oc->island_start_symbol = dsymLC->iundefsym;
3079 oc->n_islands = nundefsym;
3084 #error ocAllocateJumpIslands_MachO doesnt want USE_MMAP to be defined
3086 oc->image = stgReallocBytes(
3087 image, oc->fileSize + islandSize * nundefsym,
3088 "ocAllocateJumpIslands_MachO");
3090 oc->jump_islands = oc->image + oc->fileSize;
3091 memset(oc->jump_islands, 0, islandSize * nundefsym);
3094 break; // there can be only one LC_DSYMTAB
3096 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3101 static int ocVerifyImage_MachO(ObjectCode* oc)
3103 // FIXME: do some verifying here
3107 static int resolveImports(
3110 struct symtab_command *symLC,
3111 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3112 unsigned long *indirectSyms,
3113 struct nlist *nlist)
3117 for(i=0;i*4<sect->size;i++)
3119 // according to otool, reserved1 contains the first index into the indirect symbol table
3120 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3121 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3124 if((symbol->n_type & N_TYPE) == N_UNDF
3125 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3126 addr = (void*) (symbol->n_value);
3127 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3130 addr = lookupSymbol(nm);
3133 belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3137 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3138 ((void**)(image + sect->offset))[i] = addr;
3144 static void* makeJumpIsland(
3146 unsigned long symbolNumber,
3149 if(symbolNumber < oc->island_start_symbol ||
3150 symbolNumber - oc->island_start_symbol > oc->n_islands)
3152 symbolNumber -= oc->island_start_symbol;
3154 void *island = (void*) ((char*)oc->jump_islands + islandSize * symbolNumber);
3155 unsigned long *p = (unsigned long*) island;
3157 // lis r12, hi16(target)
3158 *p++ = 0x3d800000 | ( ((unsigned long) target) >> 16 );
3159 // ori r12, r12, lo16(target)
3160 *p++ = 0x618c0000 | ( ((unsigned long) target) & 0xFFFF );
3166 return (void*) island;
3169 static char* relocateAddress(
3172 struct section* sections,
3173 unsigned long address)
3176 for(i = 0; i < nSections; i++)
3178 if(sections[i].addr <= address
3179 && address < sections[i].addr + sections[i].size)
3181 return oc->image + sections[i].offset + address - sections[i].addr;
3184 barf("Invalid Mach-O file:"
3185 "Address out of bounds while relocating object file");
3189 static int relocateSection(
3192 struct symtab_command *symLC, struct nlist *nlist,
3193 int nSections, struct section* sections, struct section *sect)
3195 struct relocation_info *relocs;
3198 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3200 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3204 relocs = (struct relocation_info*) (image + sect->reloff);
3208 if(relocs[i].r_address & R_SCATTERED)
3210 struct scattered_relocation_info *scat =
3211 (struct scattered_relocation_info*) &relocs[i];
3215 if(scat->r_length == 2)
3217 unsigned long word = 0;
3218 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
3219 checkProddableBlock(oc,wordPtr);
3221 // Step 1: Figure out what the relocated value should be
3222 if(scat->r_type == GENERIC_RELOC_VANILLA)
3224 word = scat->r_value + sect->offset + ((long) image);
3226 else if(scat->r_type == PPC_RELOC_SECTDIFF
3227 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
3228 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
3229 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3231 struct scattered_relocation_info *pair =
3232 (struct scattered_relocation_info*) &relocs[i+1];
3234 if(!pair->r_scattered || pair->r_type != PPC_RELOC_PAIR)
3235 barf("Invalid Mach-O file: "
3236 "PPC_RELOC_*_SECTDIFF not followed by PPC_RELOC_PAIR");
3238 word = (unsigned long)
3239 (relocateAddress(oc, nSections, sections, scat->r_value)
3240 - relocateAddress(oc, nSections, sections, pair->r_value));
3244 continue; // ignore the others
3246 if(scat->r_type == GENERIC_RELOC_VANILLA
3247 || scat->r_type == PPC_RELOC_SECTDIFF)
3251 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF)
3253 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3255 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF)
3257 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3259 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3261 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3262 + ((word & (1<<15)) ? 1 : 0);
3267 continue; // FIXME: I hope it's OK to ignore all the others.
3271 struct relocation_info *reloc = &relocs[i];
3272 if(reloc->r_pcrel && !reloc->r_extern)
3275 if(reloc->r_length == 2)
3277 unsigned long word = 0;
3278 unsigned long jumpIsland = 0;
3279 long offsetToJumpIsland;
3281 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3282 checkProddableBlock(oc,wordPtr);
3284 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3288 else if(reloc->r_type == PPC_RELOC_LO16)
3290 word = ((unsigned short*) wordPtr)[1];
3291 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3293 else if(reloc->r_type == PPC_RELOC_HI16)
3295 word = ((unsigned short*) wordPtr)[1] << 16;
3296 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3298 else if(reloc->r_type == PPC_RELOC_HA16)
3300 word = ((unsigned short*) wordPtr)[1] << 16;
3301 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3303 else if(reloc->r_type == PPC_RELOC_BR24)
3306 word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
3310 if(!reloc->r_extern)
3313 sections[reloc->r_symbolnum-1].offset
3314 - sections[reloc->r_symbolnum-1].addr
3321 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3322 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3323 word = (unsigned long) (lookupSymbol(nm));
3326 belch("\nunknown symbol `%s'", nm);
3332 jumpIsland = (long) makeJumpIsland(oc,reloc->r_symbolnum,(void*)word);
3333 word -= ((long)image) + sect->offset + reloc->r_address;
3336 offsetToJumpIsland = jumpIsland
3337 - (((long)image) + sect->offset + reloc->r_address);
3342 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3347 else if(reloc->r_type == PPC_RELOC_LO16)
3349 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3352 else if(reloc->r_type == PPC_RELOC_HI16)
3354 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3357 else if(reloc->r_type == PPC_RELOC_HA16)
3359 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3360 + ((word & (1<<15)) ? 1 : 0);
3363 else if(reloc->r_type == PPC_RELOC_BR24)
3365 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3367 // The branch offset is too large.
3368 // Therefore, we try to use a jump island.
3370 barf("unconditional relative branch out of range: "
3371 "no jump island available");
3373 word = offsetToJumpIsland;
3374 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3375 barf("unconditional relative branch out of range: "
3376 "jump island out of range");
3378 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3382 barf("\nunknown relocation %d",reloc->r_type);
3389 static int ocGetNames_MachO(ObjectCode* oc)
3391 char *image = (char*) oc->image;
3392 struct mach_header *header = (struct mach_header*) image;
3393 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3394 unsigned i,curSymbol;
3395 struct segment_command *segLC = NULL;
3396 struct section *sections;
3397 struct symtab_command *symLC = NULL;
3398 struct dysymtab_command *dsymLC = NULL;
3399 struct nlist *nlist;
3400 unsigned long commonSize = 0;
3401 char *commonStorage = NULL;
3402 unsigned long commonCounter;
3404 for(i=0;i<header->ncmds;i++)
3406 if(lc->cmd == LC_SEGMENT)
3407 segLC = (struct segment_command*) lc;
3408 else if(lc->cmd == LC_SYMTAB)
3409 symLC = (struct symtab_command*) lc;
3410 else if(lc->cmd == LC_DYSYMTAB)
3411 dsymLC = (struct dysymtab_command*) lc;
3412 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3415 sections = (struct section*) (segLC+1);
3416 nlist = (struct nlist*) (image + symLC->symoff);
3418 for(i=0;i<segLC->nsects;i++)
3420 if(sections[i].size == 0)
3423 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
3425 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
3426 "ocGetNames_MachO(common symbols)");
3427 sections[i].offset = zeroFillArea - image;
3430 if(!strcmp(sections[i].sectname,"__text"))
3431 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3432 (void*) (image + sections[i].offset),
3433 (void*) (image + sections[i].offset + sections[i].size));
3434 else if(!strcmp(sections[i].sectname,"__const"))
3435 addSection(oc, SECTIONKIND_RWDATA,
3436 (void*) (image + sections[i].offset),
3437 (void*) (image + sections[i].offset + sections[i].size));
3438 else if(!strcmp(sections[i].sectname,"__data"))
3439 addSection(oc, SECTIONKIND_RWDATA,
3440 (void*) (image + sections[i].offset),
3441 (void*) (image + sections[i].offset + sections[i].size));
3442 else if(!strcmp(sections[i].sectname,"__bss")
3443 || !strcmp(sections[i].sectname,"__common"))
3444 addSection(oc, SECTIONKIND_RWDATA,
3445 (void*) (image + sections[i].offset),
3446 (void*) (image + sections[i].offset + sections[i].size));
3448 addProddableBlock(oc, (void*) (image + sections[i].offset),
3452 // count external symbols defined here
3454 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3456 if((nlist[i].n_type & N_TYPE) == N_SECT)
3459 for(i=0;i<symLC->nsyms;i++)
3461 if((nlist[i].n_type & N_TYPE) == N_UNDF
3462 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3464 commonSize += nlist[i].n_value;
3468 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3469 "ocGetNames_MachO(oc->symbols)");
3471 // insert symbols into hash table
3472 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3474 if((nlist[i].n_type & N_TYPE) == N_SECT)
3476 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3477 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3478 sections[nlist[i].n_sect-1].offset
3479 - sections[nlist[i].n_sect-1].addr
3480 + nlist[i].n_value);
3481 oc->symbols[curSymbol++] = nm;
3485 // insert local symbols into lochash
3486 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3488 if((nlist[i].n_type & N_TYPE) == N_SECT)
3490 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3491 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3492 sections[nlist[i].n_sect-1].offset
3493 - sections[nlist[i].n_sect-1].addr
3494 + nlist[i].n_value);
3499 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3500 commonCounter = (unsigned long)commonStorage;
3501 for(i=0;i<symLC->nsyms;i++)
3503 if((nlist[i].n_type & N_TYPE) == N_UNDF
3504 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3506 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3507 unsigned long sz = nlist[i].n_value;
3509 nlist[i].n_value = commonCounter;
3511 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3512 oc->symbols[curSymbol++] = nm;
3514 commonCounter += sz;
3520 static int ocResolve_MachO(ObjectCode* oc)
3522 char *image = (char*) oc->image;
3523 struct mach_header *header = (struct mach_header*) image;
3524 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3526 struct segment_command *segLC = NULL;
3527 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3528 struct symtab_command *symLC = NULL;
3529 struct dysymtab_command *dsymLC = NULL;
3530 struct nlist *nlist;
3531 unsigned long *indirectSyms;
3533 for(i=0;i<header->ncmds;i++)
3535 if(lc->cmd == LC_SEGMENT)
3536 segLC = (struct segment_command*) lc;
3537 else if(lc->cmd == LC_SYMTAB)
3538 symLC = (struct symtab_command*) lc;
3539 else if(lc->cmd == LC_DYSYMTAB)
3540 dsymLC = (struct dysymtab_command*) lc;
3541 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3544 sections = (struct section*) (segLC+1);
3545 nlist = (struct nlist*) (image + symLC->symoff);
3547 for(i=0;i<segLC->nsects;i++)
3549 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3550 la_ptrs = §ions[i];
3551 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3552 nl_ptrs = §ions[i];
3555 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3558 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3561 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3564 for(i=0;i<segLC->nsects;i++)
3566 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
3570 /* Free the local symbol table; we won't need it again. */
3571 freeHashTable(oc->lochash, NULL);
3575 Flush the data & instruction caches.
3576 Because the PPC has split data/instruction caches, we have to
3577 do that whenever we modify code at runtime.
3580 int n = (oc->fileSize + islandSize * oc->n_islands) / 4;
3581 unsigned long *p = (unsigned long*)oc->image;
3584 __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
3588 __asm__ volatile ("sync\n\tisync");
3594 * The Mach-O object format uses leading underscores. But not everywhere.
3595 * There is a small number of runtime support functions defined in
3596 * libcc_dynamic.a whose name does not have a leading underscore.
3597 * As a consequence, we can't get their address from C code.
3598 * We have to use inline assembler just to take the address of a function.
3602 static void machoInitSymbolsWithoutUnderscore()
3608 __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
3609 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
3611 RTS_MACHO_NOUNDERLINE_SYMBOLS