X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FLinker.c;h=28ba9a0aa99b6cb261eb5a14eee9c0729a1358b4;hp=718936ac5df84e10ac36150b7b458470cb5770e6;hb=b2524b3960999fffdb3767900f58825903f6560f;hpb=ad3b79d22b32760f25bf10069bd2957462be959d diff --git a/rts/Linker.c b/rts/Linker.c index 718936a..28ba9a0 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -13,8 +13,8 @@ /* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from and MREMAP_MAYMOVE from . */ -#ifdef __linux__ -#define _GNU_SOURCE +#if defined(__linux__) || defined(__GLIBC__) +#define _GNU_SOURCE 1 #endif #include "Rts.h" @@ -33,15 +33,14 @@ #include "posix/Signals.h" #endif -#if defined(mingw32_HOST_OS) // get protos for is*() #include -#endif #ifdef HAVE_SYS_TYPES_H #include #endif +#include #include #include #include @@ -71,7 +70,16 @@ #include #endif -#if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS) || defined(darwin_HOST_OS) +#if !defined(powerpc_HOST_ARCH) && \ + ( defined(linux_HOST_OS ) || defined(freebsd_HOST_OS) || \ + defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS ) || \ + defined(openbsd_HOST_OS ) || defined(darwin_HOST_OS ) || \ + defined(kfreebsdgnu_HOST_OS) ) +/* Don't use mmap on powerpc_HOST_ARCH as mmap doesn't support + * reallocating but we need to allocate jump islands just after each + * object images. Otherwise relative branches to jump islands can fail + * due to 24-bits displacement overflow. + */ #define USE_MMAP #include #include @@ -82,10 +90,10 @@ #endif -#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS) +#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS) # define OBJFORMAT_ELF -# include // regex is already used by dlopen() so this is OK - // to use here without requiring an additional lib +# include // regex is already used by dlopen() so this is OK + // to use here without requiring an additional lib #elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS) # define OBJFORMAT_PEi386 # include @@ -93,6 +101,8 @@ #elif defined(darwin_HOST_OS) # define OBJFORMAT_MACHO # include +# include +# include # include # include # include @@ -107,6 +117,10 @@ #endif #endif +#if defined(x86_64_HOST_ARCH) && defined(darwin_HOST_OS) +#define ALWAYS_PIC +#endif + /* Hash table mapping symbol names to Symbol */ static /*Str*/HashTable *symhash; @@ -114,7 +128,17 @@ static /*Str*/HashTable *symhash; static /*Str*/HashTable *stablehash; /* List of currently loaded objects */ -ObjectCode *objects = NULL; /* initially empty */ +ObjectCode *objects = NULL; /* initially empty */ + +static HsInt loadOc( ObjectCode* oc ); +static ObjectCode* mkOc( char *path, char *image, int imageSize, + char *archiveMemberName +#ifndef USE_MMAP +#ifdef darwin_HOST_OS + , int misalignment +#endif +#endif + ); #if defined(OBJFORMAT_ELF) static int ocVerifyImage_ELF ( ObjectCode* oc ); @@ -158,7 +182,7 @@ static void machoInitSymbolsWithoutUnderscore( void ); * are), and allocate jump-table slots. Unfortunately this will * SILENTLY generate crashing code for data references. This hack is * enabled by X86_64_ELF_NONPIC_HACK. - * + * * One workaround is to use shared Haskell libraries. This is * coming. Another workaround is to keep the static libraries but * compile them with -fPIC, because that will generate PIC references @@ -208,7 +232,7 @@ static void machoInitSymbolsWithoutUnderscore( void ); * We pick a default address based on the OS, but also make this * configurable via an RTS flag (+RTS -xm) */ -#if defined(x86_64_HOST_ARCH) +#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH) #if defined(MAP_32BIT) // Try to use MAP_32BIT @@ -235,20 +259,22 @@ typedef struct _RtsSymbolVal { void *addr; } RtsSymbolVal; -#define Maybe_Stable_Names SymI_HasProto(stg_mkWeakzh) \ - SymI_HasProto(stg_mkWeakForeignEnvzh) \ - SymI_HasProto(stg_makeStableNamezh) \ - SymI_HasProto(stg_finalizzeWeakzh) +#define Maybe_Stable_Names SymI_HasProto(stg_mkWeakzh) \ + SymI_HasProto(stg_mkWeakForeignEnvzh) \ + SymI_HasProto(stg_makeStableNamezh) \ + SymI_HasProto(stg_finalizzeWeakzh) #if !defined (mingw32_HOST_OS) #define RTS_POSIX_ONLY_SYMBOLS \ - SymI_HasProto(__hscore_get_saved_termios) \ - SymI_HasProto(__hscore_set_saved_termios) \ - SymI_HasProto(shutdownHaskellAndSignal) \ + SymI_HasProto(__hscore_get_saved_termios) \ + SymI_HasProto(__hscore_set_saved_termios) \ + SymI_HasProto(shutdownHaskellAndSignal) \ SymI_HasProto(lockFile) \ SymI_HasProto(unlockFile) \ - SymI_HasProto(signal_handlers) \ - SymI_HasProto(stg_sig_install) \ + SymI_HasProto(signal_handlers) \ + SymI_HasProto(stg_sig_install) \ + SymI_HasProto(rtsTimerSignal) \ + SymI_HasProto(atexit) \ SymI_NeedsProto(nocldstop) #endif @@ -343,15 +369,6 @@ typedef struct _RtsSymbolVal { #define RTS_POSIX_ONLY_SYMBOLS /**/ #define RTS_CYGWIN_ONLY_SYMBOLS /**/ -/* Extra syms gen'ed by mingw-2's gcc-3.2: */ -#if __GNUC__>=3 -#define RTS_MINGW_EXTRA_SYMS \ - SymI_NeedsProto(_imp____mb_cur_max) \ - SymI_NeedsProto(_imp___pctype) -#else -#define RTS_MINGW_EXTRA_SYMS -#endif - #if HAVE_GETTIMEOFDAY #define RTS_MINGW_GETTIMEOFDAY_SYM SymI_NeedsProto(gettimeofday) #else @@ -367,9 +384,11 @@ typedef struct _RtsSymbolVal { /* These are statically linked from the mingw libraries into the ghc executable, so we have to employ this hack. */ #define RTS_MINGW_ONLY_SYMBOLS \ - SymI_HasProto(stg_asyncReadzh) \ - SymI_HasProto(stg_asyncWritezh) \ - SymI_HasProto(stg_asyncDoProczh) \ + SymI_HasProto(stg_asyncReadzh) \ + SymI_HasProto(stg_asyncWritezh) \ + SymI_HasProto(stg_asyncDoProczh) \ + SymI_HasProto(getWin32ProgArgv) \ + SymI_HasProto(setWin32ProgArgv) \ SymI_HasProto(memset) \ SymI_HasProto(inet_ntoa) \ SymI_HasProto(inet_addr) \ @@ -392,17 +411,17 @@ typedef struct _RtsSymbolVal { SymI_HasProto(strncpy) \ SymI_HasProto(abort) \ SymI_NeedsProto(_alloca) \ - SymI_HasProto(isxdigit) \ - SymI_HasProto(isupper) \ - SymI_HasProto(ispunct) \ - SymI_HasProto(islower) \ - SymI_HasProto(isspace) \ - SymI_HasProto(isprint) \ - SymI_HasProto(isdigit) \ - SymI_HasProto(iscntrl) \ - SymI_HasProto(isalpha) \ - SymI_HasProto(isalnum) \ - SymI_HasProto(isascii) \ + SymI_HasProto(isxdigit) \ + SymI_HasProto(isupper) \ + SymI_HasProto(ispunct) \ + SymI_HasProto(islower) \ + SymI_HasProto(isspace) \ + SymI_HasProto(isprint) \ + SymI_HasProto(isdigit) \ + SymI_HasProto(iscntrl) \ + SymI_HasProto(isalpha) \ + SymI_HasProto(isalnum) \ + SymI_HasProto(isascii) \ RTS___MINGW_VFPRINTF_SYM \ SymI_HasProto(strcmp) \ SymI_HasProto(memmove) \ @@ -434,7 +453,7 @@ typedef struct _RtsSymbolVal { SymI_HasProto(expf) \ SymI_HasProto(logf) \ SymI_HasProto(sqrtf) \ - SymI_HasProto(erf) \ + SymI_HasProto(erf) \ SymI_HasProto(erfc) \ SymI_HasProto(erff) \ SymI_HasProto(erfcf) \ @@ -452,13 +471,16 @@ typedef struct _RtsSymbolVal { SymI_NeedsProto(opendir) \ SymI_NeedsProto(readdir) \ SymI_NeedsProto(rewinddir) \ - RTS_MINGW_EXTRA_SYMS \ - RTS_MINGW_GETTIMEOFDAY_SYM \ + SymI_NeedsProto(_imp____mb_cur_max) \ + SymI_NeedsProto(_imp___pctype) \ + SymI_NeedsProto(__chkstk) \ + RTS_MINGW_GETTIMEOFDAY_SYM \ SymI_NeedsProto(closedir) #endif -#if defined(darwin_TARGET_OS) && HAVE_PRINTF_LDBLSTUB -#define RTS_DARWIN_ONLY_SYMBOLS \ + +#if defined(darwin_HOST_OS) && HAVE_PRINTF_LDBLSTUB +#define RTS_DARWIN_ONLY_SYMBOLS \ SymI_NeedsProto(asprintf$LDBLStub) \ SymI_NeedsProto(err$LDBLStub) \ SymI_NeedsProto(errc$LDBLStub) \ @@ -514,18 +536,18 @@ typedef struct _RtsSymbolVal { #endif #if !defined(mingw32_HOST_OS) -#define RTS_USER_SIGNALS_SYMBOLS \ - SymI_HasProto(setIOManagerPipe) \ - SymI_HasProto(ioManagerWakeup) \ - SymI_HasProto(ioManagerSync) \ - SymI_HasProto(blockUserSignals) \ +#define RTS_USER_SIGNALS_SYMBOLS \ + SymI_HasProto(setIOManagerControlFd) \ + SymI_HasProto(setIOManagerWakeupFd) \ + SymI_HasProto(ioManagerWakeup) \ + SymI_HasProto(blockUserSignals) \ SymI_HasProto(unblockUserSignals) #else -#define RTS_USER_SIGNALS_SYMBOLS \ - SymI_HasProto(ioManagerWakeup) \ - SymI_HasProto(sendIOManagerEvent) \ - SymI_HasProto(readIOManagerEvent) \ - SymI_HasProto(getIOManagerEvent) \ +#define RTS_USER_SIGNALS_SYMBOLS \ + SymI_HasProto(ioManagerWakeup) \ + SymI_HasProto(sendIOManagerEvent) \ + SymI_HasProto(readIOManagerEvent) \ + SymI_HasProto(getIOManagerEvent) \ SymI_HasProto(console_handler) #endif @@ -548,446 +570,452 @@ typedef struct _RtsSymbolVal { #ifdef TABLES_NEXT_TO_CODE #define RTS_RET_SYMBOLS /* nothing */ #else -#define RTS_RET_SYMBOLS \ - SymI_HasProto(stg_enter_ret) \ - SymI_HasProto(stg_gc_fun_ret) \ - SymI_HasProto(stg_ap_v_ret) \ - SymI_HasProto(stg_ap_f_ret) \ - SymI_HasProto(stg_ap_d_ret) \ - SymI_HasProto(stg_ap_l_ret) \ - SymI_HasProto(stg_ap_n_ret) \ - SymI_HasProto(stg_ap_p_ret) \ - SymI_HasProto(stg_ap_pv_ret) \ - SymI_HasProto(stg_ap_pp_ret) \ - SymI_HasProto(stg_ap_ppv_ret) \ - SymI_HasProto(stg_ap_ppp_ret) \ - SymI_HasProto(stg_ap_pppv_ret) \ - SymI_HasProto(stg_ap_pppp_ret) \ - SymI_HasProto(stg_ap_ppppp_ret) \ +#define RTS_RET_SYMBOLS \ + SymI_HasProto(stg_enter_ret) \ + SymI_HasProto(stg_gc_fun_ret) \ + SymI_HasProto(stg_ap_v_ret) \ + SymI_HasProto(stg_ap_f_ret) \ + SymI_HasProto(stg_ap_d_ret) \ + SymI_HasProto(stg_ap_l_ret) \ + SymI_HasProto(stg_ap_n_ret) \ + SymI_HasProto(stg_ap_p_ret) \ + SymI_HasProto(stg_ap_pv_ret) \ + SymI_HasProto(stg_ap_pp_ret) \ + SymI_HasProto(stg_ap_ppv_ret) \ + SymI_HasProto(stg_ap_ppp_ret) \ + SymI_HasProto(stg_ap_pppv_ret) \ + SymI_HasProto(stg_ap_pppp_ret) \ + SymI_HasProto(stg_ap_ppppp_ret) \ SymI_HasProto(stg_ap_pppppp_ret) #endif /* Modules compiled with -ticky may mention ticky counters */ /* This list should marry up with the one in $(TOP)/includes/stg/Ticky.h */ -#define RTS_TICKY_SYMBOLS \ - SymI_NeedsProto(ticky_entry_ctrs) \ - SymI_NeedsProto(top_ct) \ - \ - SymI_HasProto(ENT_VIA_NODE_ctr) \ - SymI_HasProto(ENT_STATIC_THK_ctr) \ - SymI_HasProto(ENT_DYN_THK_ctr) \ - SymI_HasProto(ENT_STATIC_FUN_DIRECT_ctr) \ - SymI_HasProto(ENT_DYN_FUN_DIRECT_ctr) \ - SymI_HasProto(ENT_STATIC_CON_ctr) \ - SymI_HasProto(ENT_DYN_CON_ctr) \ - SymI_HasProto(ENT_STATIC_IND_ctr) \ - SymI_HasProto(ENT_DYN_IND_ctr) \ - SymI_HasProto(ENT_PERM_IND_ctr) \ - SymI_HasProto(ENT_PAP_ctr) \ - SymI_HasProto(ENT_AP_ctr) \ - SymI_HasProto(ENT_AP_STACK_ctr) \ - SymI_HasProto(ENT_BH_ctr) \ - SymI_HasProto(UNKNOWN_CALL_ctr) \ - SymI_HasProto(SLOW_CALL_v_ctr) \ - SymI_HasProto(SLOW_CALL_f_ctr) \ - SymI_HasProto(SLOW_CALL_d_ctr) \ - SymI_HasProto(SLOW_CALL_l_ctr) \ - SymI_HasProto(SLOW_CALL_n_ctr) \ - SymI_HasProto(SLOW_CALL_p_ctr) \ - SymI_HasProto(SLOW_CALL_pv_ctr) \ - SymI_HasProto(SLOW_CALL_pp_ctr) \ - SymI_HasProto(SLOW_CALL_ppv_ctr) \ - SymI_HasProto(SLOW_CALL_ppp_ctr) \ - SymI_HasProto(SLOW_CALL_pppv_ctr) \ - SymI_HasProto(SLOW_CALL_pppp_ctr) \ - SymI_HasProto(SLOW_CALL_ppppp_ctr) \ - SymI_HasProto(SLOW_CALL_pppppp_ctr) \ - SymI_HasProto(SLOW_CALL_OTHER_ctr) \ +#define RTS_TICKY_SYMBOLS \ + SymI_NeedsProto(ticky_entry_ctrs) \ + SymI_NeedsProto(top_ct) \ + \ + SymI_HasProto(ENT_VIA_NODE_ctr) \ + SymI_HasProto(ENT_STATIC_THK_ctr) \ + SymI_HasProto(ENT_DYN_THK_ctr) \ + SymI_HasProto(ENT_STATIC_FUN_DIRECT_ctr) \ + SymI_HasProto(ENT_DYN_FUN_DIRECT_ctr) \ + SymI_HasProto(ENT_STATIC_CON_ctr) \ + SymI_HasProto(ENT_DYN_CON_ctr) \ + SymI_HasProto(ENT_STATIC_IND_ctr) \ + SymI_HasProto(ENT_DYN_IND_ctr) \ + SymI_HasProto(ENT_PERM_IND_ctr) \ + SymI_HasProto(ENT_PAP_ctr) \ + SymI_HasProto(ENT_AP_ctr) \ + SymI_HasProto(ENT_AP_STACK_ctr) \ + SymI_HasProto(ENT_BH_ctr) \ + SymI_HasProto(UNKNOWN_CALL_ctr) \ + SymI_HasProto(SLOW_CALL_v_ctr) \ + SymI_HasProto(SLOW_CALL_f_ctr) \ + SymI_HasProto(SLOW_CALL_d_ctr) \ + SymI_HasProto(SLOW_CALL_l_ctr) \ + SymI_HasProto(SLOW_CALL_n_ctr) \ + SymI_HasProto(SLOW_CALL_p_ctr) \ + SymI_HasProto(SLOW_CALL_pv_ctr) \ + SymI_HasProto(SLOW_CALL_pp_ctr) \ + SymI_HasProto(SLOW_CALL_ppv_ctr) \ + SymI_HasProto(SLOW_CALL_ppp_ctr) \ + SymI_HasProto(SLOW_CALL_pppv_ctr) \ + SymI_HasProto(SLOW_CALL_pppp_ctr) \ + SymI_HasProto(SLOW_CALL_ppppp_ctr) \ + SymI_HasProto(SLOW_CALL_pppppp_ctr) \ + SymI_HasProto(SLOW_CALL_OTHER_ctr) \ SymI_HasProto(ticky_slow_call_unevald) \ - SymI_HasProto(SLOW_CALL_ctr) \ - SymI_HasProto(MULTI_CHUNK_SLOW_CALL_ctr) \ - SymI_HasProto(MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr) \ - SymI_HasProto(KNOWN_CALL_ctr) \ - SymI_HasProto(KNOWN_CALL_TOO_FEW_ARGS_ctr) \ - SymI_HasProto(KNOWN_CALL_EXTRA_ARGS_ctr) \ - SymI_HasProto(SLOW_CALL_FUN_TOO_FEW_ctr) \ - SymI_HasProto(SLOW_CALL_FUN_CORRECT_ctr) \ - SymI_HasProto(SLOW_CALL_FUN_TOO_MANY_ctr) \ - SymI_HasProto(SLOW_CALL_PAP_TOO_FEW_ctr) \ - SymI_HasProto(SLOW_CALL_PAP_CORRECT_ctr) \ - SymI_HasProto(SLOW_CALL_PAP_TOO_MANY_ctr) \ - SymI_HasProto(SLOW_CALL_UNEVALD_ctr) \ - SymI_HasProto(UPDF_OMITTED_ctr) \ - SymI_HasProto(UPDF_PUSHED_ctr) \ - SymI_HasProto(CATCHF_PUSHED_ctr) \ - SymI_HasProto(UPDF_RCC_PUSHED_ctr) \ - SymI_HasProto(UPDF_RCC_OMITTED_ctr) \ - SymI_HasProto(UPD_SQUEEZED_ctr) \ - SymI_HasProto(UPD_CON_IN_NEW_ctr) \ - SymI_HasProto(UPD_CON_IN_PLACE_ctr) \ - SymI_HasProto(UPD_PAP_IN_NEW_ctr) \ - SymI_HasProto(UPD_PAP_IN_PLACE_ctr) \ - SymI_HasProto(ALLOC_HEAP_ctr) \ - SymI_HasProto(ALLOC_HEAP_tot) \ - SymI_HasProto(ALLOC_FUN_ctr) \ - SymI_HasProto(ALLOC_FUN_adm) \ - SymI_HasProto(ALLOC_FUN_gds) \ - SymI_HasProto(ALLOC_FUN_slp) \ - SymI_HasProto(UPD_NEW_IND_ctr) \ - SymI_HasProto(UPD_NEW_PERM_IND_ctr) \ - SymI_HasProto(UPD_OLD_IND_ctr) \ - SymI_HasProto(UPD_OLD_PERM_IND_ctr) \ - SymI_HasProto(UPD_BH_UPDATABLE_ctr) \ - SymI_HasProto(UPD_BH_SINGLE_ENTRY_ctr) \ - SymI_HasProto(UPD_CAF_BH_UPDATABLE_ctr) \ - SymI_HasProto(UPD_CAF_BH_SINGLE_ENTRY_ctr) \ - SymI_HasProto(GC_SEL_ABANDONED_ctr) \ - SymI_HasProto(GC_SEL_MINOR_ctr) \ - SymI_HasProto(GC_SEL_MAJOR_ctr) \ - SymI_HasProto(GC_FAILED_PROMOTION_ctr) \ - SymI_HasProto(ALLOC_UP_THK_ctr) \ - SymI_HasProto(ALLOC_SE_THK_ctr) \ - SymI_HasProto(ALLOC_THK_adm) \ - SymI_HasProto(ALLOC_THK_gds) \ - SymI_HasProto(ALLOC_THK_slp) \ - SymI_HasProto(ALLOC_CON_ctr) \ - SymI_HasProto(ALLOC_CON_adm) \ - SymI_HasProto(ALLOC_CON_gds) \ - SymI_HasProto(ALLOC_CON_slp) \ - SymI_HasProto(ALLOC_TUP_ctr) \ - SymI_HasProto(ALLOC_TUP_adm) \ - SymI_HasProto(ALLOC_TUP_gds) \ - SymI_HasProto(ALLOC_TUP_slp) \ - SymI_HasProto(ALLOC_BH_ctr) \ - SymI_HasProto(ALLOC_BH_adm) \ - SymI_HasProto(ALLOC_BH_gds) \ - SymI_HasProto(ALLOC_BH_slp) \ - SymI_HasProto(ALLOC_PRIM_ctr) \ - SymI_HasProto(ALLOC_PRIM_adm) \ - SymI_HasProto(ALLOC_PRIM_gds) \ - SymI_HasProto(ALLOC_PRIM_slp) \ - SymI_HasProto(ALLOC_PAP_ctr) \ - SymI_HasProto(ALLOC_PAP_adm) \ - SymI_HasProto(ALLOC_PAP_gds) \ - SymI_HasProto(ALLOC_PAP_slp) \ - SymI_HasProto(ALLOC_TSO_ctr) \ - SymI_HasProto(ALLOC_TSO_adm) \ - SymI_HasProto(ALLOC_TSO_gds) \ - SymI_HasProto(ALLOC_TSO_slp) \ - SymI_HasProto(RET_NEW_ctr) \ - SymI_HasProto(RET_OLD_ctr) \ - SymI_HasProto(RET_UNBOXED_TUP_ctr) \ + SymI_HasProto(SLOW_CALL_ctr) \ + SymI_HasProto(MULTI_CHUNK_SLOW_CALL_ctr) \ + SymI_HasProto(MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr) \ + SymI_HasProto(KNOWN_CALL_ctr) \ + SymI_HasProto(KNOWN_CALL_TOO_FEW_ARGS_ctr) \ + SymI_HasProto(KNOWN_CALL_EXTRA_ARGS_ctr) \ + SymI_HasProto(SLOW_CALL_FUN_TOO_FEW_ctr) \ + SymI_HasProto(SLOW_CALL_FUN_CORRECT_ctr) \ + SymI_HasProto(SLOW_CALL_FUN_TOO_MANY_ctr) \ + SymI_HasProto(SLOW_CALL_PAP_TOO_FEW_ctr) \ + SymI_HasProto(SLOW_CALL_PAP_CORRECT_ctr) \ + SymI_HasProto(SLOW_CALL_PAP_TOO_MANY_ctr) \ + SymI_HasProto(SLOW_CALL_UNEVALD_ctr) \ + SymI_HasProto(UPDF_OMITTED_ctr) \ + SymI_HasProto(UPDF_PUSHED_ctr) \ + SymI_HasProto(CATCHF_PUSHED_ctr) \ + SymI_HasProto(UPDF_RCC_PUSHED_ctr) \ + SymI_HasProto(UPDF_RCC_OMITTED_ctr) \ + SymI_HasProto(UPD_SQUEEZED_ctr) \ + SymI_HasProto(UPD_CON_IN_NEW_ctr) \ + SymI_HasProto(UPD_CON_IN_PLACE_ctr) \ + SymI_HasProto(UPD_PAP_IN_NEW_ctr) \ + SymI_HasProto(UPD_PAP_IN_PLACE_ctr) \ + SymI_HasProto(ALLOC_HEAP_ctr) \ + SymI_HasProto(ALLOC_HEAP_tot) \ + SymI_HasProto(ALLOC_FUN_ctr) \ + SymI_HasProto(ALLOC_FUN_adm) \ + SymI_HasProto(ALLOC_FUN_gds) \ + SymI_HasProto(ALLOC_FUN_slp) \ + SymI_HasProto(UPD_NEW_IND_ctr) \ + SymI_HasProto(UPD_NEW_PERM_IND_ctr) \ + SymI_HasProto(UPD_OLD_IND_ctr) \ + SymI_HasProto(UPD_OLD_PERM_IND_ctr) \ + SymI_HasProto(UPD_BH_UPDATABLE_ctr) \ + SymI_HasProto(UPD_BH_SINGLE_ENTRY_ctr) \ + SymI_HasProto(UPD_CAF_BH_UPDATABLE_ctr) \ + SymI_HasProto(UPD_CAF_BH_SINGLE_ENTRY_ctr) \ + SymI_HasProto(GC_SEL_ABANDONED_ctr) \ + SymI_HasProto(GC_SEL_MINOR_ctr) \ + SymI_HasProto(GC_SEL_MAJOR_ctr) \ + SymI_HasProto(GC_FAILED_PROMOTION_ctr) \ + SymI_HasProto(ALLOC_UP_THK_ctr) \ + SymI_HasProto(ALLOC_SE_THK_ctr) \ + SymI_HasProto(ALLOC_THK_adm) \ + SymI_HasProto(ALLOC_THK_gds) \ + SymI_HasProto(ALLOC_THK_slp) \ + SymI_HasProto(ALLOC_CON_ctr) \ + SymI_HasProto(ALLOC_CON_adm) \ + SymI_HasProto(ALLOC_CON_gds) \ + SymI_HasProto(ALLOC_CON_slp) \ + SymI_HasProto(ALLOC_TUP_ctr) \ + SymI_HasProto(ALLOC_TUP_adm) \ + SymI_HasProto(ALLOC_TUP_gds) \ + SymI_HasProto(ALLOC_TUP_slp) \ + SymI_HasProto(ALLOC_BH_ctr) \ + SymI_HasProto(ALLOC_BH_adm) \ + SymI_HasProto(ALLOC_BH_gds) \ + SymI_HasProto(ALLOC_BH_slp) \ + SymI_HasProto(ALLOC_PRIM_ctr) \ + SymI_HasProto(ALLOC_PRIM_adm) \ + SymI_HasProto(ALLOC_PRIM_gds) \ + SymI_HasProto(ALLOC_PRIM_slp) \ + SymI_HasProto(ALLOC_PAP_ctr) \ + SymI_HasProto(ALLOC_PAP_adm) \ + SymI_HasProto(ALLOC_PAP_gds) \ + SymI_HasProto(ALLOC_PAP_slp) \ + SymI_HasProto(ALLOC_TSO_ctr) \ + SymI_HasProto(ALLOC_TSO_adm) \ + SymI_HasProto(ALLOC_TSO_gds) \ + SymI_HasProto(ALLOC_TSO_slp) \ + SymI_HasProto(RET_NEW_ctr) \ + SymI_HasProto(RET_OLD_ctr) \ + SymI_HasProto(RET_UNBOXED_TUP_ctr) \ SymI_HasProto(RET_SEMI_loads_avoided) // On most platforms, the garbage collector rewrites references -// to small integer and char objects to a set of common, shared ones. +// to small integer and char objects to a set of common, shared ones. // // We don't do this when compiling to Windows DLLs at the moment because -// it doesn't support cross package data references well. +// it doesn't support cross package data references well. // #if defined(__PIC__) && defined(mingw32_HOST_OS) #define RTS_INTCHAR_SYMBOLS #else -#define RTS_INTCHAR_SYMBOLS \ - SymI_HasProto(stg_CHARLIKE_closure) \ - SymI_HasProto(stg_INTLIKE_closure) +#define RTS_INTCHAR_SYMBOLS \ + SymI_HasProto(stg_CHARLIKE_closure) \ + SymI_HasProto(stg_INTLIKE_closure) #endif -#define RTS_SYMBOLS \ - Maybe_Stable_Names \ +#define RTS_SYMBOLS \ + Maybe_Stable_Names \ RTS_TICKY_SYMBOLS \ - SymI_HasProto(StgReturn) \ - SymI_HasProto(stg_enter_info) \ - SymI_HasProto(stg_gc_void_info) \ - SymI_HasProto(__stg_gc_enter_1) \ - SymI_HasProto(stg_gc_noregs) \ - SymI_HasProto(stg_gc_unpt_r1_info) \ - SymI_HasProto(stg_gc_unpt_r1) \ - SymI_HasProto(stg_gc_unbx_r1_info) \ - SymI_HasProto(stg_gc_unbx_r1) \ - SymI_HasProto(stg_gc_f1_info) \ - SymI_HasProto(stg_gc_f1) \ - SymI_HasProto(stg_gc_d1_info) \ - SymI_HasProto(stg_gc_d1) \ - SymI_HasProto(stg_gc_l1_info) \ - SymI_HasProto(stg_gc_l1) \ - SymI_HasProto(__stg_gc_fun) \ - SymI_HasProto(stg_gc_fun_info) \ - SymI_HasProto(stg_gc_gen) \ - SymI_HasProto(stg_gc_gen_info) \ - SymI_HasProto(stg_gc_gen_hp) \ - SymI_HasProto(stg_gc_ut) \ - SymI_HasProto(stg_gen_yield) \ - SymI_HasProto(stg_yield_noregs) \ - SymI_HasProto(stg_yield_to_interpreter) \ - SymI_HasProto(stg_gen_block) \ - SymI_HasProto(stg_block_noregs) \ - SymI_HasProto(stg_block_1) \ - SymI_HasProto(stg_block_takemvar) \ - SymI_HasProto(stg_block_putmvar) \ + SymI_HasProto(StgReturn) \ + SymI_HasProto(stg_enter_info) \ + SymI_HasProto(stg_gc_void_info) \ + SymI_HasProto(__stg_gc_enter_1) \ + SymI_HasProto(stg_gc_noregs) \ + SymI_HasProto(stg_gc_unpt_r1_info) \ + SymI_HasProto(stg_gc_unpt_r1) \ + SymI_HasProto(stg_gc_unbx_r1_info) \ + SymI_HasProto(stg_gc_unbx_r1) \ + SymI_HasProto(stg_gc_f1_info) \ + SymI_HasProto(stg_gc_f1) \ + SymI_HasProto(stg_gc_d1_info) \ + SymI_HasProto(stg_gc_d1) \ + SymI_HasProto(stg_gc_l1_info) \ + SymI_HasProto(stg_gc_l1) \ + SymI_HasProto(__stg_gc_fun) \ + SymI_HasProto(stg_gc_fun_info) \ + SymI_HasProto(stg_gc_gen) \ + SymI_HasProto(stg_gc_gen_info) \ + SymI_HasProto(stg_gc_gen_hp) \ + SymI_HasProto(stg_gc_ut) \ + SymI_HasProto(stg_gen_yield) \ + SymI_HasProto(stg_yield_noregs) \ + SymI_HasProto(stg_yield_to_interpreter) \ + SymI_HasProto(stg_gen_block) \ + SymI_HasProto(stg_block_noregs) \ + SymI_HasProto(stg_block_1) \ + SymI_HasProto(stg_block_takemvar) \ + SymI_HasProto(stg_block_putmvar) \ MAIN_CAP_SYM \ - SymI_HasProto(MallocFailHook) \ - SymI_HasProto(OnExitHook) \ - SymI_HasProto(OutOfHeapHook) \ - SymI_HasProto(StackOverflowHook) \ - SymI_HasProto(addDLL) \ - SymI_HasProto(__int_encodeDouble) \ - SymI_HasProto(__word_encodeDouble) \ - SymI_HasProto(__2Int_encodeDouble) \ - SymI_HasProto(__int_encodeFloat) \ - SymI_HasProto(__word_encodeFloat) \ - SymI_HasProto(stg_atomicallyzh) \ - SymI_HasProto(barf) \ - SymI_HasProto(debugBelch) \ - SymI_HasProto(errorBelch) \ + SymI_HasProto(MallocFailHook) \ + SymI_HasProto(OnExitHook) \ + SymI_HasProto(OutOfHeapHook) \ + SymI_HasProto(StackOverflowHook) \ + SymI_HasProto(addDLL) \ + SymI_HasProto(__int_encodeDouble) \ + SymI_HasProto(__word_encodeDouble) \ + SymI_HasProto(__2Int_encodeDouble) \ + SymI_HasProto(__int_encodeFloat) \ + SymI_HasProto(__word_encodeFloat) \ + SymI_HasProto(stg_atomicallyzh) \ + SymI_HasProto(barf) \ + SymI_HasProto(debugBelch) \ + SymI_HasProto(errorBelch) \ SymI_HasProto(sysErrorBelch) \ - SymI_HasProto(stg_getMaskingStatezh) \ - SymI_HasProto(stg_maskAsyncExceptionszh) \ - SymI_HasProto(stg_maskUninterruptiblezh) \ - SymI_HasProto(stg_catchzh) \ - SymI_HasProto(stg_catchRetryzh) \ - SymI_HasProto(stg_catchSTMzh) \ + SymI_HasProto(stg_getMaskingStatezh) \ + SymI_HasProto(stg_maskAsyncExceptionszh) \ + SymI_HasProto(stg_maskUninterruptiblezh) \ + SymI_HasProto(stg_catchzh) \ + SymI_HasProto(stg_catchRetryzh) \ + SymI_HasProto(stg_catchSTMzh) \ SymI_HasProto(stg_checkzh) \ SymI_HasProto(closure_flags) \ - SymI_HasProto(cmp_thread) \ - SymI_HasProto(createAdjustor) \ - SymI_HasProto(stg_decodeDoublezu2Intzh) \ - SymI_HasProto(stg_decodeFloatzuIntzh) \ - SymI_HasProto(defaultsHook) \ - SymI_HasProto(stg_delayzh) \ - SymI_HasProto(stg_deRefWeakzh) \ - SymI_HasProto(stg_deRefStablePtrzh) \ - SymI_HasProto(dirty_MUT_VAR) \ - SymI_HasProto(stg_forkzh) \ - SymI_HasProto(stg_forkOnzh) \ - SymI_HasProto(forkProcess) \ - SymI_HasProto(forkOS_createThread) \ - SymI_HasProto(freeHaskellFunctionPtr) \ - SymI_HasProto(getOrSetTypeableStore) \ - SymI_HasProto(getOrSetGHCConcSignalHandlerStore) \ - SymI_HasProto(getOrSetGHCConcPendingEventsStore) \ - SymI_HasProto(getOrSetGHCConcPendingDelaysStore) \ - SymI_HasProto(getOrSetGHCConcIOManagerThreadStore) \ - SymI_HasProto(getOrSetGHCConcProddingStore) \ - SymI_HasProto(genSymZh) \ - SymI_HasProto(genericRaise) \ - SymI_HasProto(getProgArgv) \ - SymI_HasProto(getFullProgArgv) \ - SymI_HasProto(getStablePtr) \ - SymI_HasProto(hs_init) \ - SymI_HasProto(hs_exit) \ - SymI_HasProto(hs_set_argv) \ - SymI_HasProto(hs_add_root) \ - SymI_HasProto(hs_perform_gc) \ - SymI_HasProto(hs_free_stable_ptr) \ - SymI_HasProto(hs_free_fun_ptr) \ - SymI_HasProto(hs_hpc_rootModule) \ - SymI_HasProto(hs_hpc_module) \ - SymI_HasProto(initLinker) \ + SymI_HasProto(cmp_thread) \ + SymI_HasProto(createAdjustor) \ + SymI_HasProto(stg_decodeDoublezu2Intzh) \ + SymI_HasProto(stg_decodeFloatzuIntzh) \ + SymI_HasProto(defaultsHook) \ + SymI_HasProto(stg_delayzh) \ + SymI_HasProto(stg_deRefWeakzh) \ + SymI_HasProto(stg_deRefStablePtrzh) \ + SymI_HasProto(dirty_MUT_VAR) \ + SymI_HasProto(stg_forkzh) \ + SymI_HasProto(stg_forkOnzh) \ + SymI_HasProto(forkProcess) \ + SymI_HasProto(forkOS_createThread) \ + SymI_HasProto(freeHaskellFunctionPtr) \ + SymI_HasProto(getOrSetTypeableStore) \ + SymI_HasProto(getOrSetGHCConcSignalSignalHandlerStore) \ + SymI_HasProto(getOrSetGHCConcWindowsPendingDelaysStore) \ + SymI_HasProto(getOrSetGHCConcWindowsIOManagerThreadStore) \ + SymI_HasProto(getOrSetGHCConcWindowsProddingStore) \ + SymI_HasProto(getOrSetSystemEventThreadEventManagerStore) \ + SymI_HasProto(getOrSetSystemEventThreadIOManagerThreadStore) \ + SymI_HasProto(genSymZh) \ + SymI_HasProto(genericRaise) \ + SymI_HasProto(getProgArgv) \ + SymI_HasProto(getFullProgArgv) \ + SymI_HasProto(getStablePtr) \ + SymI_HasProto(hs_init) \ + SymI_HasProto(hs_exit) \ + SymI_HasProto(hs_set_argv) \ + SymI_HasProto(hs_add_root) \ + SymI_HasProto(hs_perform_gc) \ + SymI_HasProto(hs_free_stable_ptr) \ + SymI_HasProto(hs_free_fun_ptr) \ + SymI_HasProto(hs_hpc_rootModule) \ + SymI_HasProto(hs_hpc_module) \ + SymI_HasProto(initLinker) \ SymI_HasProto(stg_unpackClosurezh) \ SymI_HasProto(stg_getApStackValzh) \ SymI_HasProto(stg_getSparkzh) \ - SymI_HasProto(stg_isCurrentThreadBoundzh) \ - SymI_HasProto(stg_isEmptyMVarzh) \ - SymI_HasProto(stg_killThreadzh) \ - SymI_HasProto(loadObj) \ - SymI_HasProto(insertStableSymbol) \ - SymI_HasProto(insertSymbol) \ - SymI_HasProto(lookupSymbol) \ - SymI_HasProto(stg_makeStablePtrzh) \ - SymI_HasProto(stg_mkApUpd0zh) \ - SymI_HasProto(stg_myThreadIdzh) \ + SymI_HasProto(stg_numSparkszh) \ + SymI_HasProto(stg_isCurrentThreadBoundzh) \ + SymI_HasProto(stg_isEmptyMVarzh) \ + SymI_HasProto(stg_killThreadzh) \ + SymI_HasProto(loadArchive) \ + SymI_HasProto(loadObj) \ + SymI_HasProto(insertStableSymbol) \ + SymI_HasProto(insertSymbol) \ + SymI_HasProto(lookupSymbol) \ + SymI_HasProto(stg_makeStablePtrzh) \ + SymI_HasProto(stg_mkApUpd0zh) \ + SymI_HasProto(stg_myThreadIdzh) \ SymI_HasProto(stg_labelThreadzh) \ - SymI_HasProto(stg_newArrayzh) \ - SymI_HasProto(stg_newBCOzh) \ - SymI_HasProto(stg_newByteArrayzh) \ - SymI_HasProto_redirect(newCAF, newDynCAF) \ - SymI_HasProto(stg_newMVarzh) \ - SymI_HasProto(stg_newMutVarzh) \ - SymI_HasProto(stg_newTVarzh) \ - SymI_HasProto(stg_noDuplicatezh) \ - SymI_HasProto(stg_atomicModifyMutVarzh) \ - SymI_HasProto(stg_newPinnedByteArrayzh) \ - SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \ - SymI_HasProto(newSpark) \ - SymI_HasProto(performGC) \ - SymI_HasProto(performMajorGC) \ - SymI_HasProto(prog_argc) \ - SymI_HasProto(prog_argv) \ - SymI_HasProto(stg_putMVarzh) \ - SymI_HasProto(stg_raisezh) \ - SymI_HasProto(stg_raiseIOzh) \ - SymI_HasProto(stg_readTVarzh) \ - SymI_HasProto(stg_readTVarIOzh) \ - SymI_HasProto(resumeThread) \ + SymI_HasProto(stg_newArrayzh) \ + SymI_HasProto(stg_newBCOzh) \ + SymI_HasProto(stg_newByteArrayzh) \ + SymI_HasProto_redirect(newCAF, newDynCAF) \ + SymI_HasProto(stg_newMVarzh) \ + SymI_HasProto(stg_newMutVarzh) \ + SymI_HasProto(stg_newTVarzh) \ + SymI_HasProto(stg_noDuplicatezh) \ + SymI_HasProto(stg_atomicModifyMutVarzh) \ + SymI_HasProto(stg_casMutVarzh) \ + SymI_HasProto(stg_newPinnedByteArrayzh) \ + SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \ + SymI_HasProto(newSpark) \ + SymI_HasProto(performGC) \ + SymI_HasProto(performMajorGC) \ + SymI_HasProto(prog_argc) \ + SymI_HasProto(prog_argv) \ + SymI_HasProto(stg_putMVarzh) \ + SymI_HasProto(stg_raisezh) \ + SymI_HasProto(stg_raiseIOzh) \ + SymI_HasProto(stg_readTVarzh) \ + SymI_HasProto(stg_readTVarIOzh) \ + SymI_HasProto(resumeThread) \ SymI_HasProto(resolveObjs) \ SymI_HasProto(stg_retryzh) \ - SymI_HasProto(rts_apply) \ - SymI_HasProto(rts_checkSchedStatus) \ - SymI_HasProto(rts_eval) \ - SymI_HasProto(rts_evalIO) \ - SymI_HasProto(rts_evalLazyIO) \ - SymI_HasProto(rts_evalStableIO) \ - SymI_HasProto(rts_eval_) \ - SymI_HasProto(rts_getBool) \ - SymI_HasProto(rts_getChar) \ - SymI_HasProto(rts_getDouble) \ - SymI_HasProto(rts_getFloat) \ - SymI_HasProto(rts_getInt) \ - SymI_HasProto(rts_getInt8) \ - SymI_HasProto(rts_getInt16) \ - SymI_HasProto(rts_getInt32) \ - SymI_HasProto(rts_getInt64) \ - SymI_HasProto(rts_getPtr) \ - SymI_HasProto(rts_getFunPtr) \ - SymI_HasProto(rts_getStablePtr) \ - SymI_HasProto(rts_getThreadId) \ - SymI_HasProto(rts_getWord) \ - SymI_HasProto(rts_getWord8) \ - SymI_HasProto(rts_getWord16) \ - SymI_HasProto(rts_getWord32) \ - SymI_HasProto(rts_getWord64) \ - SymI_HasProto(rts_lock) \ - SymI_HasProto(rts_mkBool) \ - SymI_HasProto(rts_mkChar) \ - SymI_HasProto(rts_mkDouble) \ - SymI_HasProto(rts_mkFloat) \ - SymI_HasProto(rts_mkInt) \ - SymI_HasProto(rts_mkInt8) \ - SymI_HasProto(rts_mkInt16) \ - SymI_HasProto(rts_mkInt32) \ - SymI_HasProto(rts_mkInt64) \ - SymI_HasProto(rts_mkPtr) \ - SymI_HasProto(rts_mkFunPtr) \ - SymI_HasProto(rts_mkStablePtr) \ - SymI_HasProto(rts_mkString) \ - SymI_HasProto(rts_mkWord) \ - SymI_HasProto(rts_mkWord8) \ - SymI_HasProto(rts_mkWord16) \ - SymI_HasProto(rts_mkWord32) \ - SymI_HasProto(rts_mkWord64) \ - SymI_HasProto(rts_unlock) \ + SymI_HasProto(rts_apply) \ + SymI_HasProto(rts_checkSchedStatus) \ + SymI_HasProto(rts_eval) \ + SymI_HasProto(rts_evalIO) \ + SymI_HasProto(rts_evalLazyIO) \ + SymI_HasProto(rts_evalStableIO) \ + SymI_HasProto(rts_eval_) \ + SymI_HasProto(rts_getBool) \ + SymI_HasProto(rts_getChar) \ + SymI_HasProto(rts_getDouble) \ + SymI_HasProto(rts_getFloat) \ + SymI_HasProto(rts_getInt) \ + SymI_HasProto(rts_getInt8) \ + SymI_HasProto(rts_getInt16) \ + SymI_HasProto(rts_getInt32) \ + SymI_HasProto(rts_getInt64) \ + SymI_HasProto(rts_getPtr) \ + SymI_HasProto(rts_getFunPtr) \ + SymI_HasProto(rts_getStablePtr) \ + SymI_HasProto(rts_getThreadId) \ + SymI_HasProto(rts_getWord) \ + SymI_HasProto(rts_getWord8) \ + SymI_HasProto(rts_getWord16) \ + SymI_HasProto(rts_getWord32) \ + SymI_HasProto(rts_getWord64) \ + SymI_HasProto(rts_lock) \ + SymI_HasProto(rts_mkBool) \ + SymI_HasProto(rts_mkChar) \ + SymI_HasProto(rts_mkDouble) \ + SymI_HasProto(rts_mkFloat) \ + SymI_HasProto(rts_mkInt) \ + SymI_HasProto(rts_mkInt8) \ + SymI_HasProto(rts_mkInt16) \ + SymI_HasProto(rts_mkInt32) \ + SymI_HasProto(rts_mkInt64) \ + SymI_HasProto(rts_mkPtr) \ + SymI_HasProto(rts_mkFunPtr) \ + SymI_HasProto(rts_mkStablePtr) \ + SymI_HasProto(rts_mkString) \ + SymI_HasProto(rts_mkWord) \ + SymI_HasProto(rts_mkWord8) \ + SymI_HasProto(rts_mkWord16) \ + SymI_HasProto(rts_mkWord32) \ + SymI_HasProto(rts_mkWord64) \ + SymI_HasProto(rts_unlock) \ SymI_HasProto(rts_unsafeGetMyCapability) \ - SymI_HasProto(rtsSupportsBoundThreads) \ - SymI_HasProto(setProgArgv) \ - SymI_HasProto(startupHaskell) \ - SymI_HasProto(shutdownHaskell) \ - SymI_HasProto(shutdownHaskellAndExit) \ - SymI_HasProto(stable_ptr_table) \ - SymI_HasProto(stackOverflow) \ - SymI_HasProto(stg_CAF_BLACKHOLE_info) \ - SymI_HasProto(stg_BLACKHOLE_info) \ - SymI_HasProto(__stg_EAGER_BLACKHOLE_info) \ + SymI_HasProto(rtsSupportsBoundThreads) \ + SymI_HasProto(rts_isProfiled) \ + SymI_HasProto(setProgArgv) \ + SymI_HasProto(startupHaskell) \ + SymI_HasProto(shutdownHaskell) \ + SymI_HasProto(shutdownHaskellAndExit) \ + SymI_HasProto(stable_ptr_table) \ + SymI_HasProto(stackOverflow) \ + SymI_HasProto(stg_CAF_BLACKHOLE_info) \ + SymI_HasProto(stg_BLACKHOLE_info) \ + SymI_HasProto(__stg_EAGER_BLACKHOLE_info) \ SymI_HasProto(stg_BLOCKING_QUEUE_CLEAN_info) \ - SymI_HasProto(stg_BLOCKING_QUEUE_DIRTY_info) \ + SymI_HasProto(stg_BLOCKING_QUEUE_DIRTY_info) \ SymI_HasProto(startTimer) \ - SymI_HasProto(stg_MVAR_CLEAN_info) \ - SymI_HasProto(stg_MVAR_DIRTY_info) \ - SymI_HasProto(stg_IND_STATIC_info) \ + SymI_HasProto(stg_MVAR_CLEAN_info) \ + SymI_HasProto(stg_MVAR_DIRTY_info) \ + SymI_HasProto(stg_IND_STATIC_info) \ SymI_HasProto(stg_ARR_WORDS_info) \ - SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info) \ - SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info) \ - SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN0_info) \ + SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info) \ + SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info) \ + SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN0_info) \ SymI_HasProto(stg_WEAK_info) \ - SymI_HasProto(stg_ap_v_info) \ - SymI_HasProto(stg_ap_f_info) \ - SymI_HasProto(stg_ap_d_info) \ - SymI_HasProto(stg_ap_l_info) \ - SymI_HasProto(stg_ap_n_info) \ - SymI_HasProto(stg_ap_p_info) \ - SymI_HasProto(stg_ap_pv_info) \ - SymI_HasProto(stg_ap_pp_info) \ - SymI_HasProto(stg_ap_ppv_info) \ - SymI_HasProto(stg_ap_ppp_info) \ - SymI_HasProto(stg_ap_pppv_info) \ - SymI_HasProto(stg_ap_pppp_info) \ - SymI_HasProto(stg_ap_ppppp_info) \ - SymI_HasProto(stg_ap_pppppp_info) \ - SymI_HasProto(stg_ap_0_fast) \ - SymI_HasProto(stg_ap_v_fast) \ - SymI_HasProto(stg_ap_f_fast) \ - SymI_HasProto(stg_ap_d_fast) \ - SymI_HasProto(stg_ap_l_fast) \ - SymI_HasProto(stg_ap_n_fast) \ - SymI_HasProto(stg_ap_p_fast) \ - SymI_HasProto(stg_ap_pv_fast) \ - SymI_HasProto(stg_ap_pp_fast) \ - SymI_HasProto(stg_ap_ppv_fast) \ - SymI_HasProto(stg_ap_ppp_fast) \ - SymI_HasProto(stg_ap_pppv_fast) \ - SymI_HasProto(stg_ap_pppp_fast) \ - SymI_HasProto(stg_ap_ppppp_fast) \ - SymI_HasProto(stg_ap_pppppp_fast) \ - SymI_HasProto(stg_ap_1_upd_info) \ - SymI_HasProto(stg_ap_2_upd_info) \ - SymI_HasProto(stg_ap_3_upd_info) \ - SymI_HasProto(stg_ap_4_upd_info) \ - SymI_HasProto(stg_ap_5_upd_info) \ - SymI_HasProto(stg_ap_6_upd_info) \ - SymI_HasProto(stg_ap_7_upd_info) \ - SymI_HasProto(stg_exit) \ - SymI_HasProto(stg_sel_0_upd_info) \ - SymI_HasProto(stg_sel_10_upd_info) \ - SymI_HasProto(stg_sel_11_upd_info) \ - SymI_HasProto(stg_sel_12_upd_info) \ - SymI_HasProto(stg_sel_13_upd_info) \ - SymI_HasProto(stg_sel_14_upd_info) \ - SymI_HasProto(stg_sel_15_upd_info) \ - SymI_HasProto(stg_sel_1_upd_info) \ - SymI_HasProto(stg_sel_2_upd_info) \ - SymI_HasProto(stg_sel_3_upd_info) \ - SymI_HasProto(stg_sel_4_upd_info) \ - SymI_HasProto(stg_sel_5_upd_info) \ - SymI_HasProto(stg_sel_6_upd_info) \ - SymI_HasProto(stg_sel_7_upd_info) \ - SymI_HasProto(stg_sel_8_upd_info) \ - SymI_HasProto(stg_sel_9_upd_info) \ - SymI_HasProto(stg_upd_frame_info) \ - SymI_HasProto(stg_bh_upd_frame_info) \ - SymI_HasProto(suspendThread) \ - SymI_HasProto(stg_takeMVarzh) \ - SymI_HasProto(stg_threadStatuszh) \ - SymI_HasProto(stg_tryPutMVarzh) \ - SymI_HasProto(stg_tryTakeMVarzh) \ - SymI_HasProto(stg_unmaskAsyncExceptionszh) \ + SymI_HasProto(stg_ap_v_info) \ + SymI_HasProto(stg_ap_f_info) \ + SymI_HasProto(stg_ap_d_info) \ + SymI_HasProto(stg_ap_l_info) \ + SymI_HasProto(stg_ap_n_info) \ + SymI_HasProto(stg_ap_p_info) \ + SymI_HasProto(stg_ap_pv_info) \ + SymI_HasProto(stg_ap_pp_info) \ + SymI_HasProto(stg_ap_ppv_info) \ + SymI_HasProto(stg_ap_ppp_info) \ + SymI_HasProto(stg_ap_pppv_info) \ + SymI_HasProto(stg_ap_pppp_info) \ + SymI_HasProto(stg_ap_ppppp_info) \ + SymI_HasProto(stg_ap_pppppp_info) \ + SymI_HasProto(stg_ap_0_fast) \ + SymI_HasProto(stg_ap_v_fast) \ + SymI_HasProto(stg_ap_f_fast) \ + SymI_HasProto(stg_ap_d_fast) \ + SymI_HasProto(stg_ap_l_fast) \ + SymI_HasProto(stg_ap_n_fast) \ + SymI_HasProto(stg_ap_p_fast) \ + SymI_HasProto(stg_ap_pv_fast) \ + SymI_HasProto(stg_ap_pp_fast) \ + SymI_HasProto(stg_ap_ppv_fast) \ + SymI_HasProto(stg_ap_ppp_fast) \ + SymI_HasProto(stg_ap_pppv_fast) \ + SymI_HasProto(stg_ap_pppp_fast) \ + SymI_HasProto(stg_ap_ppppp_fast) \ + SymI_HasProto(stg_ap_pppppp_fast) \ + SymI_HasProto(stg_ap_1_upd_info) \ + SymI_HasProto(stg_ap_2_upd_info) \ + SymI_HasProto(stg_ap_3_upd_info) \ + SymI_HasProto(stg_ap_4_upd_info) \ + SymI_HasProto(stg_ap_5_upd_info) \ + SymI_HasProto(stg_ap_6_upd_info) \ + SymI_HasProto(stg_ap_7_upd_info) \ + SymI_HasProto(stg_exit) \ + SymI_HasProto(stg_sel_0_upd_info) \ + SymI_HasProto(stg_sel_10_upd_info) \ + SymI_HasProto(stg_sel_11_upd_info) \ + SymI_HasProto(stg_sel_12_upd_info) \ + SymI_HasProto(stg_sel_13_upd_info) \ + SymI_HasProto(stg_sel_14_upd_info) \ + SymI_HasProto(stg_sel_15_upd_info) \ + SymI_HasProto(stg_sel_1_upd_info) \ + SymI_HasProto(stg_sel_2_upd_info) \ + SymI_HasProto(stg_sel_3_upd_info) \ + SymI_HasProto(stg_sel_4_upd_info) \ + SymI_HasProto(stg_sel_5_upd_info) \ + SymI_HasProto(stg_sel_6_upd_info) \ + SymI_HasProto(stg_sel_7_upd_info) \ + SymI_HasProto(stg_sel_8_upd_info) \ + SymI_HasProto(stg_sel_9_upd_info) \ + SymI_HasProto(stg_upd_frame_info) \ + SymI_HasProto(stg_bh_upd_frame_info) \ + SymI_HasProto(suspendThread) \ + SymI_HasProto(stg_takeMVarzh) \ + SymI_HasProto(stg_threadStatuszh) \ + SymI_HasProto(stg_tryPutMVarzh) \ + SymI_HasProto(stg_tryTakeMVarzh) \ + SymI_HasProto(stg_unmaskAsyncExceptionszh) \ SymI_HasProto(unloadObj) \ - SymI_HasProto(stg_unsafeThawArrayzh) \ - SymI_HasProto(stg_waitReadzh) \ - SymI_HasProto(stg_waitWritezh) \ - SymI_HasProto(stg_writeTVarzh) \ + SymI_HasProto(stg_unsafeThawArrayzh) \ + SymI_HasProto(stg_waitReadzh) \ + SymI_HasProto(stg_waitWritezh) \ + SymI_HasProto(stg_writeTVarzh) \ SymI_HasProto(stg_yieldzh) \ SymI_NeedsProto(stg_interp_constr_entry) \ - SymI_HasProto(alloc_blocks_lim) \ + SymI_HasProto(stg_arg_bitmaps) \ + SymI_HasProto(large_alloc_lim) \ SymI_HasProto(g0) \ SymI_HasProto(allocate) \ - SymI_HasProto(allocateExec) \ - SymI_HasProto(freeExec) \ + SymI_HasProto(allocateExec) \ + SymI_HasProto(freeExec) \ SymI_HasProto(getAllocations) \ SymI_HasProto(revertCAFs) \ SymI_HasProto(RtsFlags) \ - SymI_NeedsProto(rts_breakpoint_io_action) \ - SymI_NeedsProto(rts_stop_next_breakpoint) \ - SymI_NeedsProto(rts_stop_on_exception) \ - SymI_HasProto(stopTimer) \ - SymI_HasProto(n_capabilities) \ + SymI_NeedsProto(rts_breakpoint_io_action) \ + SymI_NeedsProto(rts_stop_next_breakpoint) \ + SymI_NeedsProto(rts_stop_on_exception) \ + SymI_HasProto(stopTimer) \ + SymI_HasProto(n_capabilities) \ SymI_HasProto(stg_traceCcszh) \ SymI_HasProto(stg_traceEventzh) \ - RTS_USER_SIGNALS_SYMBOLS \ + RTS_USER_SIGNALS_SYMBOLS \ RTS_INTCHAR_SYMBOLS // 64-bit support functions in libgcc.a #if defined(__GNUC__) && SIZEOF_VOID_P <= 4 -#define RTS_LIBGCC_SYMBOLS \ +#define RTS_LIBGCC_SYMBOLS \ SymI_NeedsProto(__divdi3) \ SymI_NeedsProto(__udivdi3) \ SymI_NeedsProto(__moddi3) \ - SymI_NeedsProto(__umoddi3) \ - SymI_NeedsProto(__muldi3) \ - SymI_NeedsProto(__ashldi3) \ - SymI_NeedsProto(__ashrdi3) \ + SymI_NeedsProto(__umoddi3) \ + SymI_NeedsProto(__muldi3) \ + SymI_NeedsProto(__ashldi3) \ + SymI_NeedsProto(__ashrdi3) \ SymI_NeedsProto(__lshrdi3) #else #define RTS_LIBGCC_SYMBOLS @@ -997,14 +1025,14 @@ typedef struct _RtsSymbolVal { // Symbols that don't have a leading underscore // on Mac OS X. They have to receive special treatment, // see machoInitSymbolsWithoutUnderscore() -#define RTS_MACHO_NOUNDERLINE_SYMBOLS \ - SymI_NeedsProto(saveFP) \ +#define RTS_MACHO_NOUNDERLINE_SYMBOLS \ + SymI_NeedsProto(saveFP) \ SymI_NeedsProto(restFP) #endif /* entirely bogus claims about types of these symbols */ #define SymI_NeedsProto(vvv) extern void vvv(void); -#if defined(__PIC__) && defined(mingw32_TARGET_OS) +#if defined(__PIC__) && defined(mingw32_HOST_OS) #define SymE_HasProto(vvv) SymE_HasProto(vvv); #define SymE_NeedsProto(vvv) extern void _imp__ ## vvv (void); #else @@ -1036,14 +1064,14 @@ RTS_LIBFFI_SYMBOLS #define SymI_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ (void*)(&(vvv)) }, #define SymE_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ - (void*)DLL_IMPORT_DATA_REF(vvv) }, + (void*)DLL_IMPORT_DATA_REF(vvv) }, #define SymI_NeedsProto(vvv) SymI_HasProto(vvv) #define SymE_NeedsProto(vvv) SymE_HasProto(vvv) // SymI_HasProto_redirect allows us to redirect references to one symbol to // another symbol. See newCAF/newDynCAF for an example. -#define SymI_HasProto_redirect(vvv,xxx) \ +#define SymI_HasProto_redirect(vvv,xxx) \ { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ (void*)(&(xxx)) }, @@ -1075,7 +1103,7 @@ static void ghciInsertStrHashTable ( char* obj_name, HashTable *table, char* key, void *data - ) + ) { if (lookupHashTable(table, (StgWord)key) == NULL) { @@ -1098,7 +1126,7 @@ static void ghciInsertStrHashTable ( char* obj_name, (char*)key, obj_name ); - exit(1); + stg_exit(1); } /* ----------------------------------------------------------------------------- * initialize the object linker @@ -1124,11 +1152,16 @@ initLinker( void ) int compileResult; #endif + IF_DEBUG(linker, debugBelch("initLinker: start\n")); + /* Make initLinker idempotent, so we can call it before evey relevant operation; that means we don't need to initialise the linker separately */ - if (linker_init_done == 1) { return; } else { - linker_init_done = 1; + if (linker_init_done == 1) { + IF_DEBUG(linker, debugBelch("initLinker: idempotent return\n")); + return; + } else { + linker_init_done = 1; } #if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)) @@ -1139,8 +1172,9 @@ initLinker( void ) /* populate the symbol table with stuff from the RTS */ for (sym = rtsSyms; sym->lbl != NULL; sym++) { - ghciInsertStrHashTable("(GHCi built-in symbols)", + ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, sym->lbl, sym->addr); + IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr)); } # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH) machoInitSymbolsWithoutUnderscore(); @@ -1154,16 +1188,16 @@ initLinker( void ) # endif /* RTLD_DEFAULT */ compileResult = regcomp(&re_invalid, - "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*invalid ELF header", + "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*(invalid ELF header|file too short)", REG_EXTENDED); ASSERT( compileResult == 0 ); compileResult = regcomp(&re_realso, - "GROUP *\\( *(([^ )])+)", + "(GROUP|INPUT) *\\( *(([^ )])+)", REG_EXTENDED); ASSERT( compileResult == 0 ); # endif -#if defined(x86_64_HOST_ARCH) +#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH) if (RtsFlags.MiscFlags.linkerMemBase != 0) { // User-override for mmap_32bit_base mmap_32bit_base = (void*)RtsFlags.MiscFlags.linkerMemBase; @@ -1179,6 +1213,9 @@ initLinker( void ) addDLL("msvcrt"); addDLL("kernel32"); #endif + + IF_DEBUG(linker, debugBelch("initLinker: done\n")); + return; } void @@ -1313,25 +1350,25 @@ addDLL( char *dll_name ) if (result == 0) { // success -- try to read the named file as a linker script match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), - MAXLINE-1); + MAXLINE-1); strncpy(line, (errmsg+(match[1].rm_so)),match_length); line[match_length] = '\0'; // make sure string is null-terminated IF_DEBUG(linker, debugBelch ("file name = '%s'\n", line)); if ((fp = fopen(line, "r")) == NULL) { - return errmsg; // return original error if open fails + return errmsg; // return original error if open fails } // try to find a GROUP ( ... ) command while (fgets(line, MAXLINE, fp) != NULL) { - IF_DEBUG(linker, debugBelch("input line = %s", line)); - if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { + IF_DEBUG(linker, debugBelch("input line = %s", line)); + if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { // success -- try to dlopen the first named file IF_DEBUG(linker, debugBelch("match%s\n","")); - line[match[1].rm_eo] = '\0'; - errmsg = internal_dlopen(line+match[1].rm_so); - break; - } - // if control reaches here, no GROUP ( ... ) directive was found - // and the original error message is returned to the caller + line[match[2].rm_eo] = '\0'; + errmsg = internal_dlopen(line+match[2].rm_so); + break; + } + // if control reaches here, no GROUP ( ... ) directive was found + // and the original error message is returned to the caller } fclose(fp); } @@ -1358,11 +1395,11 @@ addDLL( char *dll_name ) both foo.dll and foo.drv The documentation for LoadLibrary says: - If no file name extension is specified in the lpFileName - parameter, the default library extension .dll is - appended. However, the file name string can include a trailing - point character (.) to indicate that the module name has no - extension. */ + If no file name extension is specified in the lpFileName + parameter, the default library extension .dll is + appended. However, the file name string can include a trailing + point character (.) to indicate that the module name has no + extension. */ buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL"); sprintf(buf, "%s.DLL", dll_name); @@ -1433,13 +1470,15 @@ void * lookupSymbol( char *lbl ) { void *val; + IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl)); initLinker() ; ASSERT(symhash != NULL); val = lookupStrHashTable(symhash, lbl); if (val == NULL) { + IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n")); # if defined(OBJFORMAT_ELF) - return dlsym(dl_prog_handle, lbl); + return dlsym(dl_prog_handle, lbl); # elif defined(OBJFORMAT_MACHO) # if HAVE_DLFCN_H /* On OS X 10.3 and later, we use dlsym instead of the old legacy @@ -1450,15 +1489,16 @@ lookupSymbol( char *lbl ) symbol name. For now, we simply strip it off here (and ONLY here). */ + IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n", lbl)); ASSERT(lbl[0] == '_'); return dlsym(dl_prog_handle, lbl+1); # else - if(NSIsSymbolNameDefined(lbl)) { - NSSymbol symbol = NSLookupAndBindSymbol(lbl); - return NSAddressOfSymbol(symbol); - } else { - return NULL; - } + if(NSIsSymbolNameDefined(lbl)) { + NSSymbol symbol = NSLookupAndBindSymbol(lbl); + return NSAddressOfSymbol(symbol); + } else { + return NULL; + } # endif /* HAVE_DLFCN_H */ # elif defined(OBJFORMAT_PEi386) void* sym; @@ -1478,7 +1518,8 @@ lookupSymbol( char *lbl ) return NULL; # endif } else { - return val; + IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p\n", lbl, val)); + return val; } } @@ -1506,9 +1547,9 @@ void ghci_enquire ( char* addr ) a = NULL; if (a == NULL) { a = lookupStrHashTable(symhash, sym); - } + } if (a == NULL) { - // debugBelch("ghci_enquire: can't find %s\n", sym); + // debugBelch("ghci_enquire: can't find %s\n", sym); } else if (addr-DELTA <= a && a <= addr+DELTA) { debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym); @@ -1529,10 +1570,11 @@ mmapForLinker (size_t bytes, nat flags, int fd) int pagesize, size; static nat fixed = 0; + IF_DEBUG(linker, debugBelch("mmapForLinker: start\n")); pagesize = getpagesize(); size = ROUND_UP(bytes, pagesize); -#if defined(x86_64_HOST_ARCH) +#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH) mmap_again: if (mmap_32bit_base != 0) { @@ -1540,23 +1582,25 @@ mmap_again: } #endif + IF_DEBUG(linker, debugBelch("mmapForLinker: \tprotection %#0x\n", PROT_EXEC | PROT_READ | PROT_WRITE)); + IF_DEBUG(linker, debugBelch("mmapForLinker: \tflags %#0x\n", MAP_PRIVATE | TRY_MAP_32BIT | fixed | flags)); result = mmap(map_addr, size, PROT_EXEC|PROT_READ|PROT_WRITE, - MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, 0); + MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, 0); if (result == MAP_FAILED) { sysErrorBelch("mmap %lu bytes at %p",(lnat)size,map_addr); errorBelch("Try specifying an address with +RTS -xm -RTS"); stg_exit(EXIT_FAILURE); } - -#if defined(x86_64_HOST_ARCH) + +#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH) if (mmap_32bit_base != 0) { if (result == map_addr) { mmap_32bit_base = (StgWord8*)map_addr + size; } else { if ((W_)result > 0x80000000) { // oops, we were given memory over 2Gb -#if defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) +#if defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) || defined(dragonfly_HOST_OS) // Some platforms require MAP_FIXED. This is normally // a bad idea, because MAP_FIXED will overwrite // existing mappings. @@ -1579,7 +1623,7 @@ mmap_again: // ... try allocating memory somewhere else?; debugTrace(DEBUG_linker,"MAP_32BIT didn't work; gave us %lu bytes at 0x%p", bytes, result); munmap(result, size); - + // Set a base address and try again... (guess: 1Gb) mmap_32bit_base = (void*)0x40000000; goto mmap_again; @@ -1587,10 +1631,458 @@ mmap_again: } #endif + IF_DEBUG(linker, debugBelch("mmapForLinker: mapped %lu bytes starting at %p\n", (lnat)size, result)); + IF_DEBUG(linker, debugBelch("mmapForLinker: done\n")); return result; } #endif // USE_MMAP +static ObjectCode* +mkOc( char *path, char *image, int imageSize, + char *archiveMemberName +#ifndef USE_MMAP +#ifdef darwin_HOST_OS + , int misalignment +#endif +#endif + ) { + ObjectCode* oc; + + IF_DEBUG(linker, debugBelch("mkOc: start\n")); + oc = stgMallocBytes(sizeof(ObjectCode), "loadArchive(oc)"); + +# if defined(OBJFORMAT_ELF) + oc->formatName = "ELF"; +# elif defined(OBJFORMAT_PEi386) + oc->formatName = "PEi386"; +# elif defined(OBJFORMAT_MACHO) + oc->formatName = "Mach-O"; +# else + stgFree(oc); + barf("loadObj: not implemented on this platform"); +# endif + + oc->image = image; + /* sigh, strdup() isn't a POSIX function, so do it the long way */ + oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" ); + strcpy(oc->fileName, path); + + if (archiveMemberName) { + oc->archiveMemberName = stgMallocBytes( strlen(archiveMemberName)+1, "loadObj" ); + strcpy(oc->archiveMemberName, archiveMemberName); + } + else { + oc->archiveMemberName = NULL; + } + + oc->fileSize = imageSize; + oc->symbols = NULL; + oc->sections = NULL; + oc->proddables = NULL; + +#ifndef USE_MMAP +#ifdef darwin_HOST_OS + oc->misalignment = misalignment; +#endif +#endif + + /* chain it onto the list of objects */ + oc->next = objects; + objects = oc; + + IF_DEBUG(linker, debugBelch("mkOc: done\n")); + return oc; +} + +HsInt +loadArchive( char *path ) +{ + ObjectCode* oc; + char *image; + int memberSize; + FILE *f; + int n; + size_t thisFileNameSize; + char *fileName; + size_t fileNameSize; + int isObject, isGnuIndex; + char tmp[20]; + char *gnuFileIndex; + int gnuFileIndexSize; +#if defined(darwin_HOST_OS) + int i; + uint32_t nfat_arch, nfat_offset, cputype, cpusubtype; +#if defined(i386_HOST_ARCH) + const uint32_t mycputype = CPU_TYPE_X86; + const uint32_t mycpusubtype = CPU_SUBTYPE_X86_ALL; +#elif defined(x86_64_HOST_ARCH) + const uint32_t mycputype = CPU_TYPE_X86_64; + const uint32_t mycpusubtype = CPU_SUBTYPE_X86_64_ALL; +#elif defined(powerpc_HOST_ARCH) + const uint32_t mycputype = CPU_TYPE_POWERPC; + const uint32_t mycpusubtype = CPU_SUBTYPE_POWERPC_ALL; +#elif defined(powerpc64_HOST_ARCH) + const uint32_t mycputype = CPU_TYPE_POWERPC64; + const uint32_t mycpusubtype = CPU_SUBTYPE_POWERPC_ALL; +#else +#error Unknown Darwin architecture +#endif +#if !defined(USE_MMAP) + int misalignment; +#endif +#endif + + IF_DEBUG(linker, debugBelch("loadArchive: start\n")); + IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%s'\n", path)); + + gnuFileIndex = NULL; + gnuFileIndexSize = 0; + + fileNameSize = 32; + fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)"); + + f = fopen(path, "rb"); + if (!f) + barf("loadObj: can't read `%s'", path); + + /* Check if this is an archive by looking for the magic "!\n" + * string. Usually, if this fails, we barf and quit. On Darwin however, + * we may have a fat archive, which contains archives for more than + * one architecture. Fat archives start with the magic number 0xcafebabe, + * always stored big endian. If we find a fat_header, we scan through + * the fat_arch structs, searching through for one for our host + * architecture. If a matching struct is found, we read the offset + * of our archive data (nfat_offset) and seek forward nfat_offset bytes + * from the start of the file. + * + * A subtlety is that all of the members of the fat_header and fat_arch + * structs are stored big endian, so we need to call byte order + * conversion functions. + * + * If we find the appropriate architecture in a fat archive, we gobble + * its magic "!\n" string and continue processing just as if + * we had a single architecture archive. + */ + + n = fread ( tmp, 1, 8, f ); + if (n != 8) + barf("loadArchive: Failed reading header from `%s'", path); + if (strncmp(tmp, "!\n", 8) != 0) { + +#if defined(darwin_HOST_OS) + /* Not a standard archive, look for a fat archive magic number: */ + if (ntohl(*(uint32_t *)tmp) == FAT_MAGIC) { + nfat_arch = ntohl(*(uint32_t *)(tmp + 4)); + IF_DEBUG(linker, debugBelch("loadArchive: found a fat archive containing %d architectures\n", nfat_arch)); + nfat_offset = 0; + + for (i = 0; i < (int)nfat_arch; i++) { + /* search for the right arch */ + n = fread( tmp, 1, 20, f ); + if (n != 8) + barf("loadArchive: Failed reading arch from `%s'", path); + cputype = ntohl(*(uint32_t *)tmp); + cpusubtype = ntohl(*(uint32_t *)(tmp + 4)); + + if (cputype == mycputype && cpusubtype == mycpusubtype) { + IF_DEBUG(linker, debugBelch("loadArchive: found my archive in a fat archive\n")); + nfat_offset = ntohl(*(uint32_t *)(tmp + 8)); + break; + } + } + + if (nfat_offset == 0) { + barf ("loadArchive: searched %d architectures, but no host arch found", (int)nfat_arch); + } + else { + n = fseek( f, nfat_offset, SEEK_SET ); + if (n != 0) + barf("loadArchive: Failed to seek to arch in `%s'", path); + n = fread ( tmp, 1, 8, f ); + if (n != 8) + barf("loadArchive: Failed reading header from `%s'", path); + if (strncmp(tmp, "!\n", 8) != 0) { + barf("loadArchive: couldn't find archive in `%s' at offset %d", path, nfat_offset); + } + } + } + else { + barf("loadArchive: Neither an archive, nor a fat archive: `%s'", path); + } + +#else + barf("loadArchive: Not an archive: `%s'", path); +#endif + } + + IF_DEBUG(linker, debugBelch("loadArchive: loading archive contents\n")); + + while(1) { + n = fread ( fileName, 1, 16, f ); + if (n != 16) { + if (feof(f)) { + IF_DEBUG(linker, debugBelch("loadArchive: EOF while reading from '%s'\n", path)); + break; + } + else { + barf("loadArchive: Failed reading file name from `%s'", path); + } + } + +#if defined(darwin_HOST_OS) + if (strncmp(fileName, "!\n", 8) == 0) { + IF_DEBUG(linker, debugBelch("loadArchive: found the start of another archive, breaking\n")); + break; + } +#endif + + n = fread ( tmp, 1, 12, f ); + if (n != 12) + barf("loadArchive: Failed reading mod time from `%s'", path); + n = fread ( tmp, 1, 6, f ); + if (n != 6) + barf("loadArchive: Failed reading owner from `%s'", path); + n = fread ( tmp, 1, 6, f ); + if (n != 6) + barf("loadArchive: Failed reading group from `%s'", path); + n = fread ( tmp, 1, 8, f ); + if (n != 8) + barf("loadArchive: Failed reading mode from `%s'", path); + n = fread ( tmp, 1, 10, f ); + if (n != 10) + barf("loadArchive: Failed reading size from `%s'", path); + tmp[10] = '\0'; + for (n = 0; isdigit(tmp[n]); n++); + tmp[n] = '\0'; + memberSize = atoi(tmp); + + IF_DEBUG(linker, debugBelch("loadArchive: size of this archive member is %d\n", memberSize)); + n = fread ( tmp, 1, 2, f ); + if (n != 2) + barf("loadArchive: Failed reading magic from `%s'", path); + if (strncmp(tmp, "\x60\x0A", 2) != 0) + barf("loadArchive: Failed reading magic from `%s' at %ld. Got %c%c", + path, ftell(f), tmp[0], tmp[1]); + + isGnuIndex = 0; + /* Check for BSD-variant large filenames */ + if (0 == strncmp(fileName, "#1/", 3)) { + fileName[16] = '\0'; + if (isdigit(fileName[3])) { + for (n = 4; isdigit(fileName[n]); n++); + fileName[n] = '\0'; + thisFileNameSize = atoi(fileName + 3); + memberSize -= thisFileNameSize; + if (thisFileNameSize >= fileNameSize) { + /* Double it to avoid potentially continually + increasing it by 1 */ + fileNameSize = thisFileNameSize * 2; + fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)"); + } + n = fread ( fileName, 1, thisFileNameSize, f ); + if (n != (int)thisFileNameSize) { + barf("loadArchive: Failed reading filename from `%s'", + path); + } + fileName[thisFileNameSize] = 0; + + /* On OS X at least, thisFileNameSize is the size of the + fileName field, not the length of the fileName + itself. */ + thisFileNameSize = strlen(fileName); + } + else { + barf("loadArchive: BSD-variant filename size not found while reading filename from `%s'", path); + } + } + /* Check for GNU file index file */ + else if (0 == strncmp(fileName, "//", 2)) { + fileName[0] = '\0'; + thisFileNameSize = 0; + isGnuIndex = 1; + } + /* Check for a file in the GNU file index */ + else if (fileName[0] == '/') { + if (isdigit(fileName[1])) { + int i; + + for (n = 2; isdigit(fileName[n]); n++); + fileName[n] = '\0'; + n = atoi(fileName + 1); + + if (gnuFileIndex == NULL) { + barf("loadArchive: GNU-variant filename without an index while reading from `%s'", path); + } + if (n < 0 || n > gnuFileIndexSize) { + barf("loadArchive: GNU-variant filename offset %d out of range [0..%d] while reading filename from `%s'", n, gnuFileIndexSize, path); + } + if (n != 0 && gnuFileIndex[n - 1] != '\n') { + barf("loadArchive: GNU-variant filename offset %d invalid (range [0..%d]) while reading filename from `%s'", n, gnuFileIndexSize, path); + } + for (i = n; gnuFileIndex[i] != '/'; i++); + thisFileNameSize = i - n; + if (thisFileNameSize >= fileNameSize) { + /* Double it to avoid potentially continually + increasing it by 1 */ + fileNameSize = thisFileNameSize * 2; + fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)"); + } + memcpy(fileName, gnuFileIndex + n, thisFileNameSize); + fileName[thisFileNameSize] = '\0'; + } + else if (fileName[1] == ' ') { + fileName[0] = '\0'; + thisFileNameSize = 0; + } + else { + barf("loadArchive: GNU-variant filename offset not found while reading filename from `%s'", path); + } + } + /* Finally, the case where the filename field actually contains + the filename */ + else { + /* GNU ar terminates filenames with a '/', this allowing + spaces in filenames. So first look to see if there is a + terminating '/'. */ + for (thisFileNameSize = 0; + thisFileNameSize < 16; + thisFileNameSize++) { + if (fileName[thisFileNameSize] == '/') { + fileName[thisFileNameSize] = '\0'; + break; + } + } + /* If we didn't find a '/', then a space teminates the + filename. Note that if we don't find one, then + thisFileNameSize ends up as 16, and we already have the + '\0' at the end. */ + if (thisFileNameSize == 16) { + for (thisFileNameSize = 0; + thisFileNameSize < 16; + thisFileNameSize++) { + if (fileName[thisFileNameSize] == ' ') { + fileName[thisFileNameSize] = '\0'; + break; + } + } + } + } + + IF_DEBUG(linker, + debugBelch("loadArchive: Found member file `%s'\n", fileName)); + + isObject = thisFileNameSize >= 2 + && fileName[thisFileNameSize - 2] == '.' + && fileName[thisFileNameSize - 1] == 'o'; + + IF_DEBUG(linker, debugBelch("loadArchive: \tthisFileNameSize = %d\n", (int)thisFileNameSize)); + IF_DEBUG(linker, debugBelch("loadArchive: \tisObject = %d\n", isObject)); + + if (isObject) { + char *archiveMemberName; + + IF_DEBUG(linker, debugBelch("loadArchive: Member is an object file...loading...\n")); + + /* We can't mmap from the archive directly, as object + files need to be 8-byte aligned but files in .ar + archives are 2-byte aligned. When possible we use mmap + to get some anonymous memory, as on 64-bit platforms if + we use malloc then we can be given memory above 2^32. + In the mmap case we're probably wasting lots of space; + we could do better. */ +#if defined(USE_MMAP) + image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1); +#elif defined(darwin_HOST_OS) + /* See loadObj() */ + misalignment = machoGetMisalignment(f); + image = stgMallocBytes(memberSize + misalignment, "loadArchive(image)"); + image += misalignment; +#else + image = stgMallocBytes(memberSize, "loadArchive(image)"); +#endif + n = fread ( image, 1, memberSize, f ); + if (n != memberSize) { + barf("loadArchive: error whilst reading `%s'", path); + } + + archiveMemberName = stgMallocBytes(strlen(path) + thisFileNameSize + 3, + "loadArchive(file)"); + sprintf(archiveMemberName, "%s(%.*s)", + path, (int)thisFileNameSize, fileName); + + oc = mkOc(path, image, memberSize, archiveMemberName +#ifndef USE_MMAP +#ifdef darwin_HOST_OS + , misalignment +#endif +#endif + ); + + stgFree(archiveMemberName); + + if (0 == loadOc(oc)) { + stgFree(fileName); + return 0; + } + } + else if (isGnuIndex) { + if (gnuFileIndex != NULL) { + barf("loadArchive: GNU-variant index found, but already have an index, while reading filename from `%s'", path); + } + IF_DEBUG(linker, debugBelch("loadArchive: Found GNU-variant file index\n")); +#ifdef USE_MMAP + gnuFileIndex = mmapForLinker(memberSize + 1, MAP_ANONYMOUS, -1); +#else + gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)"); +#endif + n = fread ( gnuFileIndex, 1, memberSize, f ); + if (n != memberSize) { + barf("loadArchive: error whilst reading `%s'", path); + } + gnuFileIndex[memberSize] = '/'; + gnuFileIndexSize = memberSize; + } + else { + IF_DEBUG(linker, debugBelch("loadArchive: '%s' does not appear to be an object file\n", fileName)); + n = fseek(f, memberSize, SEEK_CUR); + if (n != 0) + barf("loadArchive: error whilst seeking by %d in `%s'", + memberSize, path); + } + + /* .ar files are 2-byte aligned */ + if (memberSize % 2) { + IF_DEBUG(linker, debugBelch("loadArchive: trying to read one pad byte\n")); + n = fread ( tmp, 1, 1, f ); + if (n != 1) { + if (feof(f)) { + IF_DEBUG(linker, debugBelch("loadArchive: found EOF while reading one pad byte\n")); + break; + } + else { + barf("loadArchive: Failed reading padding from `%s'", path); + } + } + IF_DEBUG(linker, debugBelch("loadArchive: successfully read one pad byte\n")); + } + IF_DEBUG(linker, debugBelch("loadArchive: reached end of archive loading while loop\n")); + } + + fclose(f); + + stgFree(fileName); + if (gnuFileIndex != NULL) { +#ifdef USE_MMAP + munmap(gnuFileIndex, gnuFileIndexSize + 1); +#else + stgFree(gnuFileIndex); +#endif + } + + IF_DEBUG(linker, debugBelch("loadArchive: done\n")); + return 1; +} + /* ----------------------------------------------------------------------------- * Load an obj (populate the global symbol table, but don't resolve yet) * @@ -1600,13 +2092,20 @@ HsInt loadObj( char *path ) { ObjectCode* oc; + char *image; + int fileSize; struct stat st; int r; #ifdef USE_MMAP int fd; #else FILE *f; +# if defined(darwin_HOST_OS) + int misalignment; +# endif #endif + IF_DEBUG(linker, debugBelch("loadObj %s\n", path)); + initLinker(); /* debugBelch("loadObj %s\n", path ); */ @@ -1633,34 +2132,13 @@ loadObj( char *path ) } } - oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)"); - -# if defined(OBJFORMAT_ELF) - oc->formatName = "ELF"; -# elif defined(OBJFORMAT_PEi386) - oc->formatName = "PEi386"; -# elif defined(OBJFORMAT_MACHO) - oc->formatName = "Mach-O"; -# else - stgFree(oc); - barf("loadObj: not implemented on this platform"); -# endif - r = stat(path, &st); - if (r == -1) { return 0; } - - /* sigh, strdup() isn't a POSIX function, so do it the long way */ - oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" ); - strcpy(oc->fileName, path); - - oc->fileSize = st.st_size; - oc->symbols = NULL; - oc->sections = NULL; - oc->proddables = NULL; + if (r == -1) { + IF_DEBUG(linker, debugBelch("File doesn't exist\n")); + return 0; + } - /* chain it onto the list of objects */ - oc->next = objects; - objects = oc; + fileSize = st.st_size; #ifdef USE_MMAP /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */ @@ -1673,7 +2151,7 @@ loadObj( char *path ) if (fd == -1) barf("loadObj: can't open `%s'", path); - oc->image = mmapForLinker(oc->fileSize, 0, fd); + image = mmapForLinker(fileSize, 0, fd); close(fd); @@ -1684,9 +2162,9 @@ loadObj( char *path ) barf("loadObj: can't read `%s'", path); # if defined(mingw32_HOST_OS) - // TODO: We would like to use allocateExec here, but allocateExec - // cannot currently allocate blocks large enough. - oc->image = VirtualAlloc(NULL, oc->fileSize, MEM_RESERVE | MEM_COMMIT, + // TODO: We would like to use allocateExec here, but allocateExec + // cannot currently allocate blocks large enough. + image = VirtualAlloc(NULL, fileSize, MEM_RESERVE | MEM_COMMIT, PAGE_EXECUTE_READWRITE); # elif defined(darwin_HOST_OS) // In a Mach-O .o file, all sections can and will be misaligned @@ -1696,30 +2174,53 @@ loadObj( char *path ) // as SSE (used by gcc for floating point) and Altivec require // 16-byte alignment. // We calculate the correct alignment from the header before - // reading the file, and then we misalign oc->image on purpose so + // reading the file, and then we misalign image on purpose so // that the actual sections end up aligned again. - oc->misalignment = machoGetMisalignment(f); - oc->image = stgMallocBytes(oc->fileSize + oc->misalignment, "loadObj(image)"); - oc->image += oc->misalignment; + misalignment = machoGetMisalignment(f); + image = stgMallocBytes(fileSize + misalignment, "loadObj(image)"); + image += misalignment; # else - oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)"); + image = stgMallocBytes(fileSize, "loadObj(image)"); # endif { int n; - n = fread ( oc->image, 1, oc->fileSize, f ); - if (n != oc->fileSize) + n = fread ( image, 1, fileSize, f ); + if (n != fileSize) barf("loadObj: error whilst reading `%s'", path); } fclose(f); #endif /* USE_MMAP */ + oc = mkOc(path, image, fileSize, NULL +#ifndef USE_MMAP +#ifdef darwin_HOST_OS + , misalignment +#endif +#endif + ); + + return loadOc(oc); +} + +static HsInt +loadOc( ObjectCode* oc ) { + int r; + + IF_DEBUG(linker, debugBelch("loadOc: start\n")); + # if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)) r = ocAllocateSymbolExtras_MachO ( oc ); - if (!r) { return r; } + if (!r) { + IF_DEBUG(linker, debugBelch("loadOc: ocAllocateSymbolExtras_MachO failed\n")); + return r; + } # elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)) r = ocAllocateSymbolExtras_ELF ( oc ); - if (!r) { return r; } + if (!r) { + IF_DEBUG(linker, debugBelch("loadOc: ocAllocateSymbolExtras_ELF failed\n")); + return r; + } #endif /* verify the in-memory image */ @@ -1732,7 +2233,10 @@ loadObj( char *path ) # else barf("loadObj: no verify method"); # endif - if (!r) { return r; } + if (!r) { + IF_DEBUG(linker, debugBelch("loadOc: ocVerifyImage_* failed\n")); + return r; + } /* build the symbol list for this image */ # if defined(OBJFORMAT_ELF) @@ -1744,10 +2248,14 @@ loadObj( char *path ) # else barf("loadObj: no getNames method"); # endif - if (!r) { return r; } + if (!r) { + IF_DEBUG(linker, debugBelch("loadOc: ocGetNames_* failed\n")); + return r; + } /* loaded, but not resolved yet */ oc->status = OBJECT_LOADED; + IF_DEBUG(linker, debugBelch("loadOc: done.\n")); return 1; } @@ -1763,23 +2271,25 @@ resolveObjs( void ) ObjectCode *oc; int r; + IF_DEBUG(linker, debugBelch("resolveObjs: start\n")); initLinker(); for (oc = objects; oc; oc = oc->next) { - if (oc->status != OBJECT_RESOLVED) { + if (oc->status != OBJECT_RESOLVED) { # if defined(OBJFORMAT_ELF) - r = ocResolve_ELF ( oc ); + r = ocResolve_ELF ( oc ); # elif defined(OBJFORMAT_PEi386) - r = ocResolve_PEi386 ( oc ); + r = ocResolve_PEi386 ( oc ); # elif defined(OBJFORMAT_MACHO) - r = ocResolve_MachO ( oc ); + r = ocResolve_MachO ( oc ); # else - barf("resolveObjs: not implemented on this platform"); + barf("resolveObjs: not implemented on this platform"); # endif - if (!r) { return r; } - oc->status = OBJECT_RESOLVED; - } + if (!r) { return r; } + oc->status = OBJECT_RESOLVED; + } } + IF_DEBUG(linker, debugBelch("resolveObjs: done\n")); return 1; } @@ -1790,6 +2300,7 @@ HsInt unloadObj( char *path ) { ObjectCode *oc, *prev; + HsBool unloadedAnyObj = HS_BOOL_FALSE; ASSERT(symhash != NULL); ASSERT(objects != NULL); @@ -1798,12 +2309,12 @@ unloadObj( char *path ) prev = NULL; for (oc = objects; oc; prev = oc, oc = oc->next) { - if (!strcmp(oc->fileName,path)) { + if (!strcmp(oc->fileName,path)) { - /* Remove all the mappings for the symbols within this - * object.. - */ - { + /* Remove all the mappings for the symbols within this + * object.. + */ + { int i; for (i = 0; i < oc->n_symbols; i++) { if (oc->symbols[i] != NULL) { @@ -1812,29 +2323,38 @@ unloadObj( char *path ) } } - if (prev == NULL) { - objects = oc->next; - } else { - prev->next = oc->next; - } - - // We're going to leave this in place, in case there are - // any pointers from the heap into it: - // #ifdef mingw32_HOST_OS - // VirtualFree(oc->image); - // #else - // stgFree(oc->image); - // #endif - stgFree(oc->fileName); - stgFree(oc->symbols); - stgFree(oc->sections); - stgFree(oc); - return 1; - } + if (prev == NULL) { + objects = oc->next; + } else { + prev->next = oc->next; + } + + // We're going to leave this in place, in case there are + // any pointers from the heap into it: + // #ifdef mingw32_HOST_OS + // VirtualFree(oc->image); + // #else + // stgFree(oc->image); + // #endif + stgFree(oc->fileName); + stgFree(oc->archiveMemberName); + stgFree(oc->symbols); + stgFree(oc->sections); + stgFree(oc); + + /* This could be a member of an archive so continue + * unloading other members. */ + unloadedAnyObj = HS_BOOL_TRUE; + } } - errorBelch("unloadObj: can't find `%s' to unload", path); - return 0; + if (unloadedAnyObj) { + return 1; + } + else { + errorBelch("unloadObj: can't find `%s' to unload", path); + return 0; + } } /* ----------------------------------------------------------------------------- @@ -1842,11 +2362,13 @@ unloadObj( char *path ) * which may be prodded during relocation, and abort if we try and write * outside any of these. */ -static void addProddableBlock ( ObjectCode* oc, void* start, int size ) +static void +addProddableBlock ( ObjectCode* oc, void* start, int size ) { ProddableBlock* pb = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock"); - /* debugBelch("aPB %p %p %d\n", oc, start, size); */ + + IF_DEBUG(linker, debugBelch("addProddableBlock: %p %p %d\n", oc, start, size)); ASSERT(size > 0); pb->start = start; pb->size = size; @@ -1854,9 +2376,11 @@ static void addProddableBlock ( ObjectCode* oc, void* start, int size ) oc->proddables = pb; } -static void checkProddableBlock ( ObjectCode* oc, void* addr ) +static void +checkProddableBlock (ObjectCode *oc, void *addr ) { ProddableBlock* pb; + for (pb = oc->proddables; pb != NULL; pb = pb->next) { char* s = (char*)(pb->start); char* e = s + pb->size - 1; @@ -1872,7 +2396,8 @@ static void checkProddableBlock ( ObjectCode* oc, void* addr ) /* ----------------------------------------------------------------------------- * Section management. */ -static void addSection ( ObjectCode* oc, SectionKind kind, +static void +addSection ( ObjectCode* oc, SectionKind kind, void* start, void* end ) { Section* s = stgMallocBytes(sizeof(Section), "addSection"); @@ -1881,10 +2406,9 @@ static void addSection ( ObjectCode* oc, SectionKind kind, s->kind = kind; s->next = oc->sections; oc->sections = s; - /* - debugBelch("addSection: %p-%p (size %d), kind %d\n", - start, ((char*)end)-1, end - start + 1, kind ); - */ + + IF_DEBUG(linker, debugBelch("addSection: %p-%p (size %ld), kind %d\n", + start, ((char*)end)-1, (long)end - (long)start + 1, kind )); } @@ -1903,7 +2427,7 @@ static void addSection ( ObjectCode* oc, SectionKind kind, Allocate additional space at the end of the object file image to make room for jump islands (powerpc, x86_64) and GOT entries (x86_64). - + PowerPC relative branch instructions have a 24 bit displacement field. As PPC code is always 4-byte-aligned, this yields a +-32MB range. If a particular imported symbol is outside this range, we have to redirect @@ -1911,7 +2435,7 @@ static void addSection ( ObjectCode* oc, SectionKind kind, address and jumps there. On x86_64, PC-relative jumps and PC-relative accesses to the GOT are limited to 32 bits (+-2GB). - + This function just allocates space for one SymbolExtra for every undefined symbol in the object file. The code for the jump islands is filled in by makeSymbolExtra below. @@ -1946,7 +2470,7 @@ static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first ) */ if( m > n ) // we need to allocate more pages { - oc->symbol_extras = mmapForLinker(sizeof(SymbolExtra) * count, + oc->symbol_extras = mmapForLinker(sizeof(SymbolExtra) * count, MAP_ANONYMOUS, -1); } else @@ -1956,7 +2480,7 @@ static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first ) #else oc->image -= misalignment; oc->image = stgReallocBytes( oc->image, - misalignment + + misalignment + aligned + sizeof (SymbolExtra) * count, "ocAllocateSymbolExtras" ); oc->image += misalignment; @@ -2007,7 +2531,7 @@ static SymbolExtra* makeSymbolExtra( ObjectCode* oc, extra->addr = target; memcpy(extra->jumpIsland, jmp, 6); #endif - + return extra; } @@ -2017,7 +2541,7 @@ static SymbolExtra* makeSymbolExtra( ObjectCode* oc, * PowerPC specifics (instruction cache flushing) * ------------------------------------------------------------------------*/ -#ifdef powerpc_TARGET_ARCH +#ifdef powerpc_HOST_ARCH /* ocFlushInstructionCache @@ -2026,12 +2550,13 @@ static SymbolExtra* makeSymbolExtra( ObjectCode* oc, do that whenever we modify code at runtime. */ -static void ocFlushInstructionCache( ObjectCode *oc ) +static void +ocFlushInstructionCacheFrom(void* begin, size_t length) { - int n = (oc->fileSize + sizeof( SymbolExtra ) * oc->n_symbol_extras + 3) / 4; - unsigned long *p = (unsigned long *) oc->image; + size_t n = (length + 3) / 4; + unsigned long* p = begin; - while( n-- ) + while (n--) { __asm__ volatile ( "dcbf 0,%0\n\t" "sync\n\t" @@ -2045,7 +2570,22 @@ static void ocFlushInstructionCache( ObjectCode *oc ) "isync" ); } + +static void +ocFlushInstructionCache( ObjectCode *oc ) +{ + /* The main object code */ + ocFlushInstructionCacheFrom(oc->image +#ifdef darwin_HOST_OS + + oc->misalignment #endif + , oc->fileSize); + + /* Jump Islands */ + ocFlushInstructionCacheFrom(oc->symbol_extras, sizeof(SymbolExtra) * oc->n_symbol_extras); +} +#endif /* powerpc_HOST_ARCH */ + /* -------------------------------------------------------------------------- * PEi386 specifics (Win32 targets) @@ -2249,7 +2789,7 @@ cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab ) */ if (name[7]==0) return name; /* The annoying case: 8 bytes. Copy into a temporary - (which is never freed ...) + (XXX which is never freed ...) */ newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name"); ASSERT(newstr); @@ -2258,6 +2798,33 @@ cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab ) return newstr; } +/* Getting the name of a section is mildly tricky, so we make a + function for it. Sadly, in one case we have to copy the string + (when it is exactly 8 bytes long there's no trailing '\0'), so for + consistency we *always* copy the string; the caller must free it +*/ +static char * +cstring_from_section_name (UChar* name, UChar* strtab) +{ + char *newstr; + + if (name[0]=='/') { + int strtab_offset = strtol((char*)name+1,NULL,10); + int len = strlen(((char*)strtab) + strtab_offset); + + newstr = stgMallocBytes(len, "cstring_from_section_symbol_name"); + strcpy((char*)newstr, (char*)((UChar*)strtab) + strtab_offset); + return newstr; + } + else + { + newstr = stgMallocBytes(9, "cstring_from_section_symbol_name"); + ASSERT(newstr); + strncpy((char*)newstr,(char*)name,8); + newstr[8] = 0; + return newstr; + } +} /* Just compares the short names (first 8 chars) */ static COFF_section * @@ -2321,15 +2888,15 @@ lookupSymbolInDLLs ( UChar *lbl ) */ sym = GetProcAddress(o_dll->instance, (char*)(lbl+1)); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; + /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ + return sym; } } sym = GetProcAddress(o_dll->instance, (char*)lbl); if (sym != NULL) { /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ return sym; - } + } } return NULL; } @@ -2375,8 +2942,8 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI) /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) { errorBelch("%s: Invalid PEi386 word size or endiannness: %d", - oc->fileName, - (int)(hdr->Characteristics)); + oc->fileName, + (int)(hdr->Characteristics)); return 0; } /* If the string table size is way crazy, this might indicate that @@ -2447,17 +3014,17 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) ); if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) { - /* If the relocation field (a short) has overflowed, the - * real count can be found in the first reloc entry. - * - * See Section 4.1 (last para) of the PE spec (rev6.0). - */ + /* If the relocation field (a short) has overflowed, the + * real count can be found in the first reloc entry. + * + * See Section 4.1 (last para) of the PE spec (rev6.0). + */ COFF_reloc* rel = (COFF_reloc*) myindex ( sizeof_COFF_reloc, reltab, 0 ); - noRelocs = rel->VirtualAddress; - j = 1; + noRelocs = rel->VirtualAddress; + j = 1; } else { - noRelocs = sectab_i->NumberOfRelocations; + noRelocs = sectab_i->NumberOfRelocations; j = 0; } @@ -2471,7 +3038,7 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) rel->VirtualAddress ); sym = (COFF_symbol*) myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex ); - /* Hmm..mysterious looking offset - what's it for? SOF */ + /* Hmm..mysterious looking offset - what's it for? SOF */ printName ( sym->Name, strtab -10 ); debugBelch("'\n" ); } @@ -2556,7 +3123,16 @@ ocGetNames_PEi386 ( ObjectCode* oc ) COFF_section* sectab_i = (COFF_section*) myindex ( sizeof_COFF_section, sectab, i ); - if (0 != strcmp((char*)sectab_i->Name, ".bss")) continue; + + char *secname = cstring_from_section_name(sectab_i->Name, strtab); + + if (0 != strcmp(secname, ".bss")) { + stgFree(secname); + continue; + } + + stgFree(secname); + /* sof 10/05: the PE spec text isn't too clear regarding what * the SizeOfRawData field is supposed to hold for object * file sections containing just uninitialized data -- for executables, @@ -2597,7 +3173,10 @@ ocGetNames_PEi386 ( ObjectCode* oc ) COFF_section* sectab_i = (COFF_section*) myindex ( sizeof_COFF_section, sectab, i ); - IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name )); + + char *secname = cstring_from_section_name(sectab_i->Name, strtab); + + IF_DEBUG(linker, debugBelch("section name = %s\n", secname )); # if 0 /* I'm sure this is the Right Way to do it. However, the @@ -2609,12 +3188,12 @@ ocGetNames_PEi386 ( ObjectCode* oc ) kind = SECTIONKIND_CODE_OR_RODATA; # endif - if (0==strcmp(".text",(char*)sectab_i->Name) || - 0==strcmp(".rdata",(char*)sectab_i->Name)|| - 0==strcmp(".rodata",(char*)sectab_i->Name)) + if (0==strcmp(".text",(char*)secname) || + 0==strcmp(".rdata",(char*)secname)|| + 0==strcmp(".rodata",(char*)secname)) kind = SECTIONKIND_CODE_OR_RODATA; - if (0==strcmp(".data",(char*)sectab_i->Name) || - 0==strcmp(".bss",(char*)sectab_i->Name)) + if (0==strcmp(".data",(char*)secname) || + 0==strcmp(".bss",(char*)secname)) kind = SECTIONKIND_RWDATA; ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0); @@ -2627,16 +3206,18 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (kind == SECTIONKIND_OTHER /* Ignore sections called which contain stabs debugging information. */ - && 0 != strcmp(".stab", (char*)sectab_i->Name) - && 0 != strcmp(".stabstr", (char*)sectab_i->Name) + && 0 != strcmp(".stab", (char*)secname) + && 0 != strcmp(".stabstr", (char*)secname) /* ignore constructor section for now */ - && 0 != strcmp(".ctors", (char*)sectab_i->Name) + && 0 != strcmp(".ctors", (char*)secname) /* ignore section generated from .ident */ - && 0!= strcmp("/4", (char*)sectab_i->Name) - /* ignore unknown section that appeared in gcc 3.4.5(?) */ - && 0!= strcmp(".reloc", (char*)sectab_i->Name) + && 0!= strncmp(".debug", (char*)secname, 6) + /* ignore unknown section that appeared in gcc 3.4.5(?) */ + && 0!= strcmp(".reloc", (char*)secname) + && 0 != strcmp(".rdata$zzz", (char*)secname) ) { - errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName); + errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", secname, oc->fileName); + stgFree(secname); return 0; } @@ -2644,6 +3225,8 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addSection(oc, kind, start, end); addProddableBlock(oc, start, end - start + 1); } + + stgFree(secname); } /* Copy exported symbols into the ObjectCode. */ @@ -2682,7 +3265,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) } else if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED - && symtab_i->Value > 0) { + && symtab_i->Value > 0) { /* This symbol isn't in any section at all, ie, global bss. Allocate zeroed space for it. */ addr = stgCallocBytes(1, symtab_i->Value, @@ -2775,38 +3358,46 @@ ocResolve_PEi386 ( ObjectCode* oc ) ((UChar*)(oc->image)) + sectab_i->PointerToRelocations ); + char *secname = cstring_from_section_name(sectab_i->Name, strtab); + /* Ignore sections called which contain stabs debugging information. */ - if (0 == strcmp(".stab", (char*)sectab_i->Name) - || 0 == strcmp(".stabstr", (char*)sectab_i->Name) - || 0 == strcmp(".ctors", (char*)sectab_i->Name)) - continue; + if (0 == strcmp(".stab", (char*)secname) + || 0 == strcmp(".stabstr", (char*)secname) + || 0 == strcmp(".ctors", (char*)secname) + || 0 == strncmp(".debug", (char*)secname, 6) + || 0 == strcmp(".rdata$zzz", (char*)secname)) { + stgFree(secname); + continue; + } + + stgFree(secname); if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) { - /* If the relocation field (a short) has overflowed, the - * real count can be found in the first reloc entry. + /* If the relocation field (a short) has overflowed, the + * real count can be found in the first reloc entry. + * + * See Section 4.1 (last para) of the PE spec (rev6.0). * - * See Section 4.1 (last para) of the PE spec (rev6.0). - * - * Nov2003 update: the GNU linker still doesn't correctly - * handle the generation of relocatable object files with - * overflown relocations. Hence the output to warn of potential - * troubles. - */ + * Nov2003 update: the GNU linker still doesn't correctly + * handle the generation of relocatable object files with + * overflown relocations. Hence the output to warn of potential + * troubles. + */ COFF_reloc* rel = (COFF_reloc*) myindex ( sizeof_COFF_reloc, reltab, 0 ); - noRelocs = rel->VirtualAddress; + noRelocs = rel->VirtualAddress; - /* 10/05: we now assume (and check for) a GNU ld that is capable - * of handling object files with (>2^16) of relocs. - */ + /* 10/05: we now assume (and check for) a GNU ld that is capable + * of handling object files with (>2^16) of relocs. + */ #if 0 - debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n", - noRelocs); + debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n", + noRelocs); #endif - j = 1; + j = 1; } else { - noRelocs = sectab_i->NumberOfRelocations; + noRelocs = sectab_i->NumberOfRelocations; j = 0; } @@ -2875,25 +3466,25 @@ ocResolve_PEi386 ( ObjectCode* oc ) Also I don't know if A should be added, but so far it has always been zero. - SOF 05/2005: 'A' (old contents of *pP) have been observed - to contain values other than zero (the 'wx' object file - that came with wxhaskell-0.9.4; dunno how it was compiled..). - So, add displacement to old value instead of asserting - A to be zero. Fixes wxhaskell-related crashes, and no other - ill effects have been observed. - - Update: the reason why we're seeing these more elaborate - relocations is due to a switch in how the NCG compiles SRTs - and offsets to them from info tables. SRTs live in .(ro)data, - while info tables live in .text, causing GAS to emit REL32/DISP32 - relocations with non-zero values. Adding the displacement is - the right thing to do. - */ + SOF 05/2005: 'A' (old contents of *pP) have been observed + to contain values other than zero (the 'wx' object file + that came with wxhaskell-0.9.4; dunno how it was compiled..). + So, add displacement to old value instead of asserting + A to be zero. Fixes wxhaskell-related crashes, and no other + ill effects have been observed. + + Update: the reason why we're seeing these more elaborate + relocations is due to a switch in how the NCG compiles SRTs + and offsets to them from info tables. SRTs live in .(ro)data, + while info tables live in .text, causing GAS to emit REL32/DISP32 + relocations with non-zero values. Adding the displacement is + the right thing to do. + */ *pP = S - ((UInt32)pP) - 4 + A; break; default: debugBelch("%s: unhandled PEi386 relocation type %d", - oc->fileName, reltab_j->Type); + oc->fileName, reltab_j->Type); return 0; } @@ -2936,7 +3527,7 @@ ocResolve_PEi386 ( ObjectCode* oc ) #endif /* If elf.h doesn't define it */ -# ifndef R_X86_64_PC64 +# ifndef R_X86_64_PC64 # define R_X86_64_PC64 24 # endif @@ -3092,31 +3683,6 @@ PLTSize(void) * Generic ELF functions */ -static char * -findElfSection ( void* objImage, Elf_Word sh_type ) -{ - char* ehdrC = (char*)objImage; - Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset; - char* ptr = NULL; - int i; - - for (i = 0; i < ehdr->e_shnum; i++) { - if (shdr[i].sh_type == sh_type - /* Ignore the section header's string table. */ - && i != ehdr->e_shstrndx - /* Ignore string tables named .stabstr, as they contain - debugging info. */ - && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8) - ) { - ptr = ehdrC + shdr[i].sh_offset; - break; - } - } - return ptr; -} - static int ocVerifyImage_ELF ( ObjectCode* oc ) { @@ -3124,7 +3690,6 @@ ocVerifyImage_ELF ( ObjectCode* oc ) Elf_Sym* stab; int i, j, nent, nstrtab, nsymtabs; char* sh_strtab; - char* strtab; char* ehdrC = (char*)(oc->image); Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC; @@ -3204,43 +3769,85 @@ ocVerifyImage_ELF ( ObjectCode* oc ) IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset )); IF_DEBUG(linker,debugBelch(" (%p .. %p) ", ehdrC + shdr[i].sh_offset, - ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1)); + ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1)); - if (shdr[i].sh_type == SHT_REL) { - IF_DEBUG(linker,debugBelch("Rel " )); - } else if (shdr[i].sh_type == SHT_RELA) { - IF_DEBUG(linker,debugBelch("RelA " )); - } else { - IF_DEBUG(linker,debugBelch(" ")); +#define SECTION_INDEX_VALID(ndx) (ndx > SHN_UNDEF && ndx < ehdr->e_shnum) + + switch (shdr[i].sh_type) { + + case SHT_REL: + case SHT_RELA: + IF_DEBUG(linker,debugBelch( shdr[i].sh_type == SHT_REL ? "Rel " : "RelA ")); + + if (!SECTION_INDEX_VALID(shdr[i].sh_link)) { + if (shdr[i].sh_link == SHN_UNDEF) + errorBelch("\n%s: relocation section #%d has no symbol table\n" + "This object file has probably been fully striped. " + "Such files cannot be linked.\n", + oc->archiveMemberName ? oc->archiveMemberName : oc->fileName, i); + else + errorBelch("\n%s: relocation section #%d has an invalid link field (%d)\n", + oc->archiveMemberName ? oc->archiveMemberName : oc->fileName, + i, shdr[i].sh_link); + return 0; + } + if (shdr[shdr[i].sh_link].sh_type != SHT_SYMTAB) { + errorBelch("\n%s: relocation section #%d does not link to a symbol table\n", + oc->archiveMemberName ? oc->archiveMemberName : oc->fileName, i); + return 0; + } + if (!SECTION_INDEX_VALID(shdr[i].sh_info)) { + errorBelch("\n%s: relocation section #%d has an invalid info field (%d)\n", + oc->archiveMemberName ? oc->archiveMemberName : oc->fileName, + i, shdr[i].sh_info); + return 0; + } + + break; + case SHT_SYMTAB: + IF_DEBUG(linker,debugBelch("Sym ")); + + if (!SECTION_INDEX_VALID(shdr[i].sh_link)) { + errorBelch("\n%s: symbol table section #%d has an invalid link field (%d)\n", + oc->archiveMemberName ? oc->archiveMemberName : oc->fileName, + i, shdr[i].sh_link); + return 0; + } + if (shdr[shdr[i].sh_link].sh_type != SHT_STRTAB) { + errorBelch("\n%s: symbol table section #%d does not link to a string table\n", + oc->archiveMemberName ? oc->archiveMemberName : oc->fileName, i); + + return 0; + } + break; + case SHT_STRTAB: IF_DEBUG(linker,debugBelch("Str ")); break; + default: IF_DEBUG(linker,debugBelch(" ")); break; } if (sh_strtab) { - IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name )); + IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name )); } } - IF_DEBUG(linker,debugBelch( "\nString tables" )); - strtab = NULL; + IF_DEBUG(linker,debugBelch( "\nString tables\n" )); nstrtab = 0; for (i = 0; i < ehdr->e_shnum; i++) { if (shdr[i].sh_type == SHT_STRTAB /* Ignore the section header's string table. */ && i != ehdr->e_shstrndx - /* Ignore string tables named .stabstr, as they contain + /* Ignore string tables named .stabstr, as they contain debugging info. */ && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8) ) { - IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i )); - strtab = ehdrC + shdr[i].sh_offset; + IF_DEBUG(linker,debugBelch(" section %d is a normal string table\n", i )); nstrtab++; } } - if (nstrtab != 1) { - errorBelch("%s: no string tables, or too many", oc->fileName); - return 0; + if (nstrtab == 0) { + IF_DEBUG(linker,debugBelch(" no normal string tables (potentially, but not necessarily a problem)\n")); } nsymtabs = 0; - IF_DEBUG(linker,debugBelch( "\nSymbol tables" )); + IF_DEBUG(linker,debugBelch( "Symbol tables\n" )); for (i = 0; i < ehdr->e_shnum; i++) { if (shdr[i].sh_type != SHT_SYMTAB) continue; IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i )); @@ -3282,13 +3889,17 @@ ocVerifyImage_ELF ( ObjectCode* oc ) } IF_DEBUG(linker,debugBelch(" " )); - IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name )); + IF_DEBUG(linker,debugBelch("name=%s\n", + ehdrC + shdr[shdr[i].sh_link].sh_offset + + stab[j].st_name )); } } if (nsymtabs == 0) { - errorBelch("%s: didn't find any symbol tables", oc->fileName); - return 0; + // Not having a symbol table is not in principle a problem. + // When an object file has no symbols then the 'strip' program + // typically will remove the symbol table entirely. + IF_DEBUG(linker,debugBelch(" no symbol tables (potentially, but not necessarily a problem)\n")); } return 1; @@ -3299,28 +3910,28 @@ static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss ) *is_bss = FALSE; if (hdr->sh_type == SHT_PROGBITS - && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) { - /* .text-style section */ - return SECTIONKIND_CODE_OR_RODATA; + && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) { + /* .text-style section */ + return SECTIONKIND_CODE_OR_RODATA; } if (hdr->sh_type == SHT_PROGBITS - && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) { - /* .data-style section */ - return SECTIONKIND_RWDATA; + && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) { + /* .data-style section */ + return SECTIONKIND_RWDATA; } if (hdr->sh_type == SHT_PROGBITS - && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) { - /* .rodata-style section */ - return SECTIONKIND_CODE_OR_RODATA; + && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) { + /* .rodata-style section */ + return SECTIONKIND_CODE_OR_RODATA; } if (hdr->sh_type == SHT_NOBITS - && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) { - /* .bss-style section */ - *is_bss = TRUE; - return SECTIONKIND_RWDATA; + && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) { + /* .bss-style section */ + *is_bss = TRUE; + return SECTIONKIND_RWDATA; } return SECTIONKIND_OTHER; @@ -3335,16 +3946,11 @@ ocGetNames_ELF ( ObjectCode* oc ) char* ehdrC = (char*)(oc->image); Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC; - char* strtab = findElfSection ( ehdrC, SHT_STRTAB ); + char* strtab; Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); ASSERT(symhash != NULL); - if (!strtab) { - errorBelch("%s: no strtab", oc->fileName); - return 0; - } - k = 0; for (i = 0; i < ehdr->e_shnum; i++) { /* Figure out what kind of section it is. Logic derived from @@ -3360,10 +3966,10 @@ ocGetNames_ELF ( ObjectCode* oc ) char* zspace = stgCallocBytes(1, shdr[i].sh_size, "ocGetNames_ELF(BSS)"); shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC); - /* + /* debugBelch("BSS section at 0x%x, size %d\n", zspace, shdr[i].sh_size); - */ + */ } /* fill in the section info */ @@ -3377,12 +3983,16 @@ ocGetNames_ELF ( ObjectCode* oc ) /* copy stuff into this module's object symbol table */ stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset); + strtab = ehdrC + shdr[shdr[i].sh_link].sh_offset; nent = shdr[i].sh_size / sizeof(Elf_Sym); oc->n_symbols = nent; oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*), "ocGetNames_ELF(oc->symbols)"); + //TODO: we ignore local symbols anyway right? So we can use the + // shdr[i].sh_info to get the index of the first non-local symbol + // ie we should use j = shdr[i].sh_info for (j = 0; j < nent; j++) { char isLocal = FALSE; /* avoids uninit-var warning */ @@ -3390,37 +4000,37 @@ ocGetNames_ELF ( ObjectCode* oc ) char* nm = strtab + stab[j].st_name; int secno = stab[j].st_shndx; - /* Figure out if we want to add it; if so, set ad to its + /* Figure out if we want to add it; if so, set ad to its address. Otherwise leave ad == NULL. */ if (secno == SHN_COMMON) { isLocal = FALSE; ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)"); - /* + /* debugBelch("COMMON symbol, size %d name %s\n", stab[j].st_size, nm); - */ - /* Pointless to do addProddableBlock() for this area, + */ + /* Pointless to do addProddableBlock() for this area, since the linker should never poke around in it. */ - } + } else if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL ) /* and not an undefined symbol */ && stab[j].st_shndx != SHN_UNDEF - /* and not in a "special section" */ + /* and not in a "special section" */ && stab[j].st_shndx < SHN_LORESERVE && - /* and it's a not a section or string table or anything silly */ + /* and it's a not a section or string table or anything silly */ ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC || ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT || ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE ) ) { - /* Section 0 is the undefined section, hence > and not >=. */ + /* Section 0 is the undefined section, hence > and not >=. */ ASSERT(secno > 0 && secno < ehdr->e_shnum); - /* + /* if (shdr[secno].sh_type == SHT_NOBITS) { debugBelch(" BSS symbol, size %d off %d name %s\n", stab[j].st_size, stab[j].st_value, nm); @@ -3432,8 +4042,8 @@ ocGetNames_ELF ( ObjectCode* oc ) } else { #ifdef ELF_FUNCTION_DESC /* dlsym() and the initialisation table both give us function - * descriptors, so to be consistent we store function descriptors - * in the symbol table */ + * descriptors, so to be consistent we store function descriptors + * in the symbol table */ if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC) ad = (char *)allocateFunctionDesc((Elf_Addr)ad); #endif @@ -3447,7 +4057,7 @@ ocGetNames_ELF ( ObjectCode* oc ) if (ad != NULL) { ASSERT(nm != NULL); - oc->symbols[j] = nm; + oc->symbols[j] = nm; /* Acquire! */ if (isLocal) { /* Ignore entirely. */ @@ -3480,29 +4090,32 @@ ocGetNames_ELF ( ObjectCode* oc ) relocations appear to be of this form. */ static int do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, - Elf_Shdr* shdr, int shnum, - Elf_Sym* stab, char* strtab ) + Elf_Shdr* shdr, int shnum ) { int j; char *symbol; Elf_Word* targ; Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset); + Elf_Sym* stab; + char* strtab; int nent = shdr[shnum].sh_size / sizeof(Elf_Rel); int target_shndx = shdr[shnum].sh_info; int symtab_shndx = shdr[shnum].sh_link; + int strtab_shndx = shdr[symtab_shndx].sh_link; stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset); + strtab= (char*) (ehdrC + shdr[ strtab_shndx ].sh_offset); targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset); - IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n", - target_shndx, symtab_shndx )); + IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d and strtab %d\n", + target_shndx, symtab_shndx, strtab_shndx )); /* Skip sections that we're not interested in. */ { int is_bss; SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss); if (kind == SECTIONKIND_OTHER) { - IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)")); - return 1; + IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)")); + return 1; } } @@ -3526,7 +4139,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, S = 0; } else { Elf_Sym sym = stab[ELF_R_SYM(info)]; - /* First see if it is a local symbol. */ + /* First see if it is a local symbol. */ if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) { /* Yes, so we can get the address directly from the ELF symbol table. */ @@ -3535,7 +4148,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, (ehdrC + shdr[ sym.st_shndx ].sh_offset + stab[ELF_R_SYM(info)].st_value); - } else { + } else { symbol = strtab + sym.st_name; stablePtr = (StgStablePtr)lookupHashTable(stablehash, (StgWord)symbol); if (NULL == stablePtr) { @@ -3547,16 +4160,16 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, S_tmp = stableVal; S = (Elf_Addr)S_tmp; } - } + } if (!S) { errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol); - return 0; + return 0; } IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S )); } IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n", - (void*)P, (void*)S, (void*)A )); + (void*)P, (void*)S, (void*)A )); checkProddableBlock ( oc, pP ); value = S + A; @@ -3568,7 +4181,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, # endif default: errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n", - oc->fileName, (lnat)ELF_R_TYPE(info)); + oc->fileName, (lnat)ELF_R_TYPE(info)); return 0; } @@ -3580,18 +4193,21 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, sparc-solaris relocations appear to be of this form. */ static int do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, - Elf_Shdr* shdr, int shnum, - Elf_Sym* stab, char* strtab ) + Elf_Shdr* shdr, int shnum ) { int j; char *symbol = NULL; Elf_Addr targ; Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset); + Elf_Sym* stab; + char* strtab; int nent = shdr[shnum].sh_size / sizeof(Elf_Rela); int target_shndx = shdr[shnum].sh_info; int symtab_shndx = shdr[shnum].sh_link; + int strtab_shndx = shdr[symtab_shndx].sh_link; stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset); + strtab= (char*) (ehdrC + shdr[ strtab_shndx ].sh_offset); targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset); IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n", target_shndx, symtab_shndx )); @@ -3622,7 +4238,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, S = 0; } else { Elf_Sym sym = stab[ELF_R_SYM(info)]; - /* First see if it is a local symbol. */ + /* First see if it is a local symbol. */ if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) { /* Yes, so we can get the address directly from the ELF symbol table. */ @@ -3631,28 +4247,28 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, (ehdrC + shdr[ sym.st_shndx ].sh_offset + stab[ELF_R_SYM(info)].st_value); #ifdef ELF_FUNCTION_DESC - /* Make a function descriptor for this function */ + /* Make a function descriptor for this function */ if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) { S = allocateFunctionDesc(S + A); - A = 0; + A = 0; } #endif - } else { + } else { /* No, so look up the name in our global table. */ symbol = strtab + sym.st_name; S_tmp = lookupSymbol( symbol ); S = (Elf_Addr)S_tmp; #ifdef ELF_FUNCTION_DESC - /* If a function, already a function descriptor - we would - have to copy it to add an offset. */ + /* If a function, already a function descriptor - we would + have to copy it to add an offset. */ if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0)) errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A); #endif - } + } if (!S) { - errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol); - return 0; + errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol); + return 0; } IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S )); } @@ -3695,16 +4311,16 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, aligned according to the architecture requirements. */ case R_SPARC_UA32: - w2 = (Elf_Word)value; + w2 = (Elf_Word)value; // SPARC doesn't do misaligned writes of 32 bit words, - // so we have to do this one byte-at-a-time. - char *pPc = (char*)pP; - pPc[0] = (char) ((Elf_Word)(w2 & 0xff000000) >> 24); - pPc[1] = (char) ((Elf_Word)(w2 & 0x00ff0000) >> 16); - pPc[2] = (char) ((Elf_Word)(w2 & 0x0000ff00) >> 8); - pPc[3] = (char) ((Elf_Word)(w2 & 0x000000ff)); - break; + // so we have to do this one byte-at-a-time. + char *pPc = (char*)pP; + pPc[0] = (char) ((Elf_Word)(w2 & 0xff000000) >> 24); + pPc[1] = (char) ((Elf_Word)(w2 & 0x00ff0000) >> 16); + pPc[2] = (char) ((Elf_Word)(w2 & 0x0000ff00) >> 8); + pPc[3] = (char) ((Elf_Word)(w2 & 0x000000ff)); + break; case R_SPARC_32: w2 = (Elf_Word)value; @@ -3718,7 +4334,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, case R_PPC_ADDR16_HI: *(Elf32_Half*) P = value >> 16; break; - + case R_PPC_ADDR16_HA: *(Elf32_Half*) P = (value + 0x8000) >> 16; break; @@ -3755,15 +4371,18 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, #if x86_64_HOST_ARCH case R_X86_64_64: - *(Elf64_Xword *)P = value; - break; + *(Elf64_Xword *)P = value; + break; case R_X86_64_PC32: { - StgInt64 off = value - P; - if (off >= 0x7fffffffL || off < -0x80000000L) { +#if defined(ALWAYS_PIC) + barf("R_X86_64_PC32 relocation, but ALWAYS_PIC."); +#else + StgInt64 off = value - P; + if (off >= 0x7fffffffL || off < -0x80000000L) { #if X86_64_ELF_NONPIC_HACK - StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S) + StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S) -> jumpIsland; off = pltAddress + A - P; #else @@ -3771,69 +4390,82 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, symbol, off, oc->fileName ); #endif } - *(Elf64_Word *)P = (Elf64_Word)off; - break; + *(Elf64_Word *)P = (Elf64_Word)off; +#endif + break; } case R_X86_64_PC64: { - StgInt64 off = value - P; - *(Elf64_Word *)P = (Elf64_Word)off; - break; + StgInt64 off = value - P; + *(Elf64_Word *)P = (Elf64_Word)off; + break; } case R_X86_64_32: - if (value >= 0x7fffffffL) { -#if X86_64_ELF_NONPIC_HACK +#if defined(ALWAYS_PIC) + barf("R_X86_64_32 relocation, but ALWAYS_PIC."); +#else + if (value >= 0x7fffffffL) { +#if X86_64_ELF_NONPIC_HACK StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S) -> jumpIsland; value = pltAddress + A; #else barf("R_X86_64_32 relocation out of range: %s = %p\nRecompile %s with -fPIC.", - symbol, value, oc->fileName ); + symbol, value, oc->fileName ); #endif } - *(Elf64_Word *)P = (Elf64_Word)value; - break; + *(Elf64_Word *)P = (Elf64_Word)value; +#endif + break; case R_X86_64_32S: - if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) { -#if X86_64_ELF_NONPIC_HACK +#if defined(ALWAYS_PIC) + barf("R_X86_64_32S relocation, but ALWAYS_PIC."); +#else + if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) { +#if X86_64_ELF_NONPIC_HACK StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S) -> jumpIsland; value = pltAddress + A; #else barf("R_X86_64_32S relocation out of range: %s = %p\nRecompile %s with -fPIC.", - symbol, value, oc->fileName ); + symbol, value, oc->fileName ); #endif - } - *(Elf64_Sword *)P = (Elf64_Sword)value; - break; - + } + *(Elf64_Sword *)P = (Elf64_Sword)value; +#endif + break; + case R_X86_64_GOTPCREL: { StgInt64 gotAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)->addr; - StgInt64 off = gotAddress + A - P; - *(Elf64_Word *)P = (Elf64_Word)off; - break; + StgInt64 off = gotAddress + A - P; + *(Elf64_Word *)P = (Elf64_Word)off; + break; } - + case R_X86_64_PLT32: { - StgInt64 off = value - P; - if (off >= 0x7fffffffL || off < -0x80000000L) { +#if defined(ALWAYS_PIC) + barf("R_X86_64_PLT32 relocation, but ALWAYS_PIC."); +#else + StgInt64 off = value - P; + if (off >= 0x7fffffffL || off < -0x80000000L) { StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S) -> jumpIsland; off = pltAddress + A - P; - } - *(Elf64_Word *)P = (Elf64_Word)off; - break; + } + *(Elf64_Word *)P = (Elf64_Word)off; +#endif + break; } #endif default: errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n", - oc->fileName, (lnat)ELF_R_TYPE(info)); + oc->fileName, (lnat)ELF_R_TYPE(info)); return 0; } @@ -3844,35 +4476,20 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, static int ocResolve_ELF ( ObjectCode* oc ) { - char *strtab; int shnum, ok; - Elf_Sym* stab = NULL; char* ehdrC = (char*)(oc->image); Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - /* first find "the" symbol table */ - stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB ); - - /* also go find the string table */ - strtab = findElfSection ( ehdrC, SHT_STRTAB ); - - if (stab == NULL || strtab == NULL) { - errorBelch("%s: can't find string or symbol table", oc->fileName); - return 0; - } - /* Process the relocation sections. */ for (shnum = 0; shnum < ehdr->e_shnum; shnum++) { if (shdr[shnum].sh_type == SHT_REL) { - ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr, - shnum, stab, strtab ); + ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr, shnum ); if (!ok) return ok; } else if (shdr[shnum].sh_type == SHT_RELA) { - ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr, - shnum, stab, strtab ); + ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr, shnum ); if (!ok) return ok; } } @@ -3905,15 +4522,19 @@ static int ocAllocateSymbolExtras_ELF( ObjectCode *oc ) if( i == ehdr->e_shnum ) { - errorBelch( "This ELF file contains no symtab" ); - return 0; + // Not having a symbol table is not in principle a problem. + // When an object file has no symbols then the 'strip' program + // typically will remove the symbol table entirely. + IF_DEBUG(linker, debugBelch( "The ELF file %s contains no symtab\n", + oc->archiveMemberName ? oc->archiveMemberName : oc->fileName )); + return 1; } if( shdr[i].sh_entsize != sizeof( Elf_Sym ) ) { errorBelch( "The entry size (%d) of the symtab isn't %d\n", (int) shdr[i].sh_entsize, (int) sizeof( Elf_Sym ) ); - + return 0; } @@ -3948,91 +4569,121 @@ static int ocAllocateSymbolExtras_ELF( ObjectCode *oc ) #endif #ifdef powerpc_HOST_ARCH -static int ocAllocateSymbolExtras_MachO(ObjectCode* oc) +static int +ocAllocateSymbolExtras_MachO(ObjectCode* oc) { struct mach_header *header = (struct mach_header *) oc->image; struct load_command *lc = (struct load_command *) (header + 1); unsigned i; - for( i = 0; i < header->ncmds; i++ ) - { - if( lc->cmd == LC_SYMTAB ) - { + IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: start\n")); + + for (i = 0; i < header->ncmds; i++) { + if (lc->cmd == LC_SYMTAB) { + // Find out the first and last undefined external // symbol, so we don't have to allocate too many - // jump islands. + // jump islands/GOT entries. + struct symtab_command *symLC = (struct symtab_command *) lc; unsigned min = symLC->nsyms, max = 0; struct nlist *nlist = symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff) : NULL; - for(i=0;insyms;i++) - { - if(nlist[i].n_type & N_STAB) + + for (i = 0; i < symLC->nsyms; i++) { + + if (nlist[i].n_type & N_STAB) { ; - else if(nlist[i].n_type & N_EXT) - { + } else if (nlist[i].n_type & N_EXT) { + if((nlist[i].n_type & N_TYPE) == N_UNDF - && (nlist[i].n_value == 0)) - { - if(i < min) + && (nlist[i].n_value == 0)) { + + if (i < min) { min = i; - if(i > max) + } + + if (i > max) { max = i; } } } - if(max >= min) + } + + if (max >= min) { return ocAllocateSymbolExtras(oc, max - min + 1, min); + } break; } - + lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize ); } + return ocAllocateSymbolExtras(oc,0,0); } + #endif #ifdef x86_64_HOST_ARCH -static int ocAllocateSymbolExtras_MachO(ObjectCode* oc) +static int +ocAllocateSymbolExtras_MachO(ObjectCode* oc) { struct mach_header *header = (struct mach_header *) oc->image; struct load_command *lc = (struct load_command *) (header + 1); unsigned i; - for( i = 0; i < header->ncmds; i++ ) - { - if( lc->cmd == LC_SYMTAB ) - { + IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: start\n")); + + for (i = 0; i < header->ncmds; i++) { + if (lc->cmd == LC_SYMTAB) { + // Just allocate one entry for every symbol struct symtab_command *symLC = (struct symtab_command *) lc; - + + IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: allocate %d symbols\n", symLC->nsyms)); + IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: done\n")); return ocAllocateSymbolExtras(oc, symLC->nsyms, 0); } - + lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize ); } + + IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: allocated no symbols\n")); + IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: done\n")); return ocAllocateSymbolExtras(oc,0,0); } #endif -static int ocVerifyImage_MachO(ObjectCode* oc) +static int +ocVerifyImage_MachO(ObjectCode * oc) { char *image = (char*) oc->image; struct mach_header *header = (struct mach_header*) image; -#if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH - if(header->magic != MH_MAGIC_64) + IF_DEBUG(linker, debugBelch("ocVerifyImage_MachO: start\n")); + +#if x86_64_HOST_ARCH || powerpc64_HOST_ARCH + if(header->magic != MH_MAGIC_64) { + errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n", + oc->fileName, MH_MAGIC_64, header->magic); return 0; + } #else - if(header->magic != MH_MAGIC) + if(header->magic != MH_MAGIC) { + errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n", + oc->fileName, MH_MAGIC, header->magic); return 0; + } #endif + // FIXME: do some more verifying here + IF_DEBUG(linker, debugBelch("ocVerifyImage_MachO: done\n")); return 1; } -static int resolveImports( +static int +resolveImports( ObjectCode* oc, char *image, struct symtab_command *symLC, @@ -4043,51 +4694,60 @@ static int resolveImports( unsigned i; size_t itemSize = 4; + IF_DEBUG(linker, debugBelch("resolveImports: start\n")); + #if i386_HOST_ARCH int isJumpTable = 0; - if(!strcmp(sect->sectname,"__jump_table")) - { + + if (strcmp(sect->sectname,"__jump_table") == 0) { isJumpTable = 1; itemSize = 5; ASSERT(sect->reserved2 == itemSize); } + #endif for(i=0; i*itemSize < sect->size;i++) { - // according to otool, reserved1 contains the first index into the indirect symbol table - struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]]; - char *nm = image + symLC->stroff + symbol->n_un.n_strx; - void *addr = NULL; - - if((symbol->n_type & N_TYPE) == N_UNDF - && (symbol->n_type & N_EXT) && (symbol->n_value != 0)) - addr = (void*) (symbol->n_value); - else - addr = lookupSymbol(nm); - if(!addr) - { - errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm); - return 0; - } - ASSERT(addr); + // according to otool, reserved1 contains the first index into the indirect symbol table + struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]]; + char *nm = image + symLC->stroff + symbol->n_un.n_strx; + void *addr = NULL; + + IF_DEBUG(linker, debugBelch("resolveImports: resolving %s\n", nm)); + + if ((symbol->n_type & N_TYPE) == N_UNDF + && (symbol->n_type & N_EXT) && (symbol->n_value != 0)) { + addr = (void*) (symbol->n_value); + IF_DEBUG(linker, debugBelch("resolveImports: undefined external %s has value %p\n", nm, addr)); + } else { + addr = lookupSymbol(nm); + IF_DEBUG(linker, debugBelch("resolveImports: looking up %s, %p\n", nm, addr)); + } + if (!addr) + { + errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm); + return 0; + } + ASSERT(addr); #if i386_HOST_ARCH - if(isJumpTable) - { + if (isJumpTable) { checkProddableBlock(oc,image + sect->offset + i*itemSize); - *(image + sect->offset + i*itemSize) = 0xe9; // jmp + + *(image + sect->offset + i * itemSize) = 0xe9; // jmp opcode *(unsigned*)(image + sect->offset + i*itemSize + 1) = (char*)addr - (image + sect->offset + i*itemSize + 5); } else #endif - { - checkProddableBlock(oc,((void**)(image + sect->offset)) + i); - ((void**)(image + sect->offset))[i] = addr; + { + checkProddableBlock(oc,((void**)(image + sect->offset)) + i); + ((void**)(image + sect->offset))[i] = addr; } } + IF_DEBUG(linker, debugBelch("resolveImports: done\n")); return 1; } @@ -4098,9 +4758,11 @@ static unsigned long relocateAddress( unsigned long address) { int i; - for(i = 0; i < nSections; i++) + IF_DEBUG(linker, debugBelch("relocateAddress: start\n")); + for (i = 0; i < nSections; i++) { - if(sections[i].addr <= address + IF_DEBUG(linker, debugBelch(" relocating address in section %d\n", i)); + if (sections[i].addr <= address && address < sections[i].addr + sections[i].size) { return (unsigned long)oc->image @@ -4119,25 +4781,29 @@ static int relocateSection( int nSections, struct section* sections, struct section *sect) { struct relocation_info *relocs; - int i,n; + int i, n; + + IF_DEBUG(linker, debugBelch("relocateSection: start\n")); if(!strcmp(sect->sectname,"__la_symbol_ptr")) - return 1; + return 1; else if(!strcmp(sect->sectname,"__nl_symbol_ptr")) - return 1; + return 1; else if(!strcmp(sect->sectname,"__la_sym_ptr2")) - return 1; + return 1; else if(!strcmp(sect->sectname,"__la_sym_ptr3")) - return 1; + return 1; n = sect->nreloc; + IF_DEBUG(linker, debugBelch("relocateSection: number of relocations: %d\n", n)); + relocs = (struct relocation_info*) (image + sect->reloff); for(i=0;ioffset + reloc->r_address; uint64_t thing; /* We shouldn't need to initialise this, but gcc on OS X 64 bit @@ -4145,7 +4811,7 @@ static int relocateSection( uint64_t value = 0; uint64_t baseValue; int type = reloc->r_type; - + checkProddableBlock(oc,thingPtr); switch(reloc->r_length) { @@ -4168,33 +4834,56 @@ static int relocateSection( default: barf("Unknown size."); } - - if(type == X86_64_RELOC_GOT + + IF_DEBUG(linker, + debugBelch("relocateSection: length = %d, thing = %" PRId64 ", baseValue = %p\n", + reloc->r_length, thing, (char *)baseValue)); + + if (type == X86_64_RELOC_GOT || type == X86_64_RELOC_GOT_LOAD) { + struct nlist *symbol = &nlist[reloc->r_symbolnum]; + char *nm = image + symLC->stroff + symbol->n_un.n_strx; + + IF_DEBUG(linker, debugBelch("relocateSection: making jump island for %s, extern = %d, X86_64_RELOC_GOT\n", nm, reloc->r_extern)); ASSERT(reloc->r_extern); - value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)->addr; - + value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, (unsigned long)lookupSymbol(nm))->addr; + type = X86_64_RELOC_SIGNED; } else if(reloc->r_extern) { struct nlist *symbol = &nlist[reloc->r_symbolnum]; char *nm = image + symLC->stroff + symbol->n_un.n_strx; - if(symbol->n_value == 0) - value = (uint64_t) lookupSymbol(nm); - else + + IF_DEBUG(linker, debugBelch("relocateSection: looking up external symbol %s\n", nm)); + IF_DEBUG(linker, debugBelch(" : type = %d\n", symbol->n_type)); + IF_DEBUG(linker, debugBelch(" : sect = %d\n", symbol->n_sect)); + IF_DEBUG(linker, debugBelch(" : desc = %d\n", symbol->n_desc)); + IF_DEBUG(linker, debugBelch(" : value = %p\n", (void *)symbol->n_value)); + if ((symbol->n_type & N_TYPE) == N_SECT) { value = relocateAddress(oc, nSections, sections, symbol->n_value); + IF_DEBUG(linker, debugBelch("relocateSection, defined external symbol %s, relocated address %p\n", nm, (void *)value)); + } + else { + value = (uint64_t) lookupSymbol(nm); + IF_DEBUG(linker, debugBelch("relocateSection: external symbol %s, address %p\n", nm, (void *)value)); + } } else { - value = sections[reloc->r_symbolnum-1].offset - - sections[reloc->r_symbolnum-1].addr - + (uint64_t) image; + // If the relocation is not through the global offset table + // or external, then set the value to the baseValue. This + // will leave displacements into the __const section + // unchanged (as they ought to be). + + value = baseValue; } - - if(type == X86_64_RELOC_BRANCH) + + IF_DEBUG(linker, debugBelch("relocateSection: value = %p\n", (void *)value)); + + if (type == X86_64_RELOC_BRANCH) { if((int32_t)(value - baseValue) != (int64_t)(value - baseValue)) { @@ -4205,7 +4894,7 @@ static int relocateSection( ASSERT((int32_t)(value - baseValue) == (int64_t)(value - baseValue)); type = X86_64_RELOC_SIGNED; } - + switch(type) { case X86_64_RELOC_UNSIGNED: @@ -4226,7 +4915,7 @@ static int relocateSection( default: barf("unkown relocation"); } - + switch(reloc->r_length) { case 0: @@ -4243,18 +4932,18 @@ static int relocateSection( break; } #else - if(relocs[i].r_address & R_SCATTERED) - { - struct scattered_relocation_info *scat = - (struct scattered_relocation_info*) &relocs[i]; - - if(!scat->r_pcrel) - { - if(scat->r_length == 2) - { - unsigned long word = 0; - unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address); - checkProddableBlock(oc,wordPtr); + if(relocs[i].r_address & R_SCATTERED) + { + struct scattered_relocation_info *scat = + (struct scattered_relocation_info*) &relocs[i]; + + if(!scat->r_pcrel) + { + if(scat->r_length == 2) + { + unsigned long word = 0; + unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address); + checkProddableBlock(oc,wordPtr); // Note on relocation types: // i386 uses the GENERIC_RELOC_* types, @@ -4264,51 +4953,53 @@ static int relocateSection( // Therefore, we use GENERIC_RELOC_VANILLA // and GENERIC_RELOC_PAIR instead of the PPC variants, // and use #ifdefs for the other types. - - // Step 1: Figure out what the relocated value should be - if(scat->r_type == GENERIC_RELOC_VANILLA) - { - word = *wordPtr + (unsigned long) relocateAddress( - oc, + + // Step 1: Figure out what the relocated value should be + if (scat->r_type == GENERIC_RELOC_VANILLA) { + word = *wordPtr + + (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value) - scat->r_value; - } + } #ifdef powerpc_HOST_ARCH - else if(scat->r_type == PPC_RELOC_SECTDIFF - || scat->r_type == PPC_RELOC_LO16_SECTDIFF - || scat->r_type == PPC_RELOC_HI16_SECTDIFF - || scat->r_type == PPC_RELOC_HA16_SECTDIFF - || scat->r_type == PPC_RELOC_LOCAL_SECTDIFF) + else if(scat->r_type == PPC_RELOC_SECTDIFF + || scat->r_type == PPC_RELOC_LO16_SECTDIFF + || scat->r_type == PPC_RELOC_HI16_SECTDIFF + || scat->r_type == PPC_RELOC_HA16_SECTDIFF + || scat->r_type == PPC_RELOC_LOCAL_SECTDIFF) #else else if(scat->r_type == GENERIC_RELOC_SECTDIFF || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF) #endif - { - struct scattered_relocation_info *pair = - (struct scattered_relocation_info*) &relocs[i+1]; + { + struct scattered_relocation_info *pair = + (struct scattered_relocation_info*) &relocs[i+1]; - if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR) - barf("Invalid Mach-O file: " - "RELOC_*_SECTDIFF not followed by RELOC_PAIR"); + if (!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR) { + barf("Invalid Mach-O file: " + "RELOC_*_SECTDIFF not followed by RELOC_PAIR"); + } - word = (unsigned long) - (relocateAddress(oc, nSections, sections, scat->r_value) - - relocateAddress(oc, nSections, sections, pair->r_value)); - i++; - } + word = (unsigned long) + (relocateAddress(oc, nSections, sections, scat->r_value) + - relocateAddress(oc, nSections, sections, pair->r_value)); + i++; + } #ifdef powerpc_HOST_ARCH - else if(scat->r_type == PPC_RELOC_HI16 + else if(scat->r_type == PPC_RELOC_HI16 || scat->r_type == PPC_RELOC_LO16 || scat->r_type == PPC_RELOC_HA16 || scat->r_type == PPC_RELOC_LO14) { // these are generated by label+offset things - struct relocation_info *pair = &relocs[i+1]; - if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR) - barf("Invalid Mach-O file: " - "PPC_RELOC_* not followed by PPC_RELOC_PAIR"); - + struct relocation_info *pair = &relocs[i+1]; + + if ((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR) { + barf("Invalid Mach-O file: " + "PPC_RELOC_* not followed by PPC_RELOC_PAIR"); + } + if(scat->r_type == PPC_RELOC_LO16) { word = ((unsigned short*) wordPtr)[1]; @@ -4330,21 +5021,22 @@ static int relocateSection( word = ((unsigned short*) wordPtr)[1] << 16; word += ((short)relocs[i+1].r_address & (short)0xFFFF); } - - + + word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value) - scat->r_value; - + i++; } #endif - else - { - barf ("Don't know how to handle this Mach-O " - "scattered relocation entry: " + else { + barf ("Don't know how to handle this Mach-O " + "scattered relocation entry: " "object file %s; entry type %ld; " - "address %#lx\n", - oc->fileName, scat->r_type, scat->r_address); + "address %#lx\n", + OC_INFORMATIVE_FILENAME(oc), + scat->r_type, + scat->r_address); return 0; } @@ -4360,51 +5052,59 @@ static int relocateSection( *wordPtr = word; } #ifdef powerpc_HOST_ARCH - else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16) + else if (scat->r_type == PPC_RELOC_LO16_SECTDIFF + || scat->r_type == PPC_RELOC_LO16) { ((unsigned short*) wordPtr)[1] = word & 0xFFFF; } - else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16) + else if (scat->r_type == PPC_RELOC_HI16_SECTDIFF + || scat->r_type == PPC_RELOC_HI16) { ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF; } - else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16) + else if (scat->r_type == PPC_RELOC_HA16_SECTDIFF + || scat->r_type == PPC_RELOC_HA16) { ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF) + ((word & (1<<15)) ? 1 : 0); } #endif - } - else - { - barf("Can't handle Mach-O scattered relocation entry " - "with this r_length tag: " + } + else + { + barf("Can't handle Mach-O scattered relocation entry " + "with this r_length tag: " "object file %s; entry type %ld; " - "r_length tag %ld; address %#lx\n", - oc->fileName, scat->r_type, scat->r_length, + "r_length tag %ld; address %#lx\n", + OC_INFORMATIVE_FILENAME(oc), + scat->r_type, + scat->r_length, scat->r_address); return 0; - } - } - else /* scat->r_pcrel */ - { - barf("Don't know how to handle *PC-relative* Mach-O " - "scattered relocation entry: " - "object file %s; entry type %ld; address %#lx\n", - oc->fileName, scat->r_type, scat->r_address); + } + } + else /* scat->r_pcrel */ + { + barf("Don't know how to handle *PC-relative* Mach-O " + "scattered relocation entry: " + "object file %s; entry type %ld; address %#lx\n", + OC_INFORMATIVE_FILENAME(oc), + scat->r_type, + scat->r_address); return 0; - } - - } - else /* !(relocs[i].r_address & R_SCATTERED) */ - { - struct relocation_info *reloc = &relocs[i]; - if(reloc->r_pcrel && !reloc->r_extern) - continue; - - if(reloc->r_length == 2) - { - unsigned long word = 0; + } + + } + else /* !(relocs[i].r_address & R_SCATTERED) */ + { + struct relocation_info *reloc = &relocs[i]; + if (reloc->r_pcrel && !reloc->r_extern) { + IF_DEBUG(linker, debugBelch("relocateSection: pc relative but not external, skipping\n")); + continue; + } + + if (reloc->r_length == 2) { + unsigned long word = 0; #ifdef powerpc_HOST_ARCH unsigned long jumpIsland = 0; long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value @@ -4412,66 +5112,58 @@ static int relocateSection( // bugs. #endif - unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address); - checkProddableBlock(oc,wordPtr); + unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address); + checkProddableBlock(oc,wordPtr); - if(reloc->r_type == GENERIC_RELOC_VANILLA) - { - word = *wordPtr; - } + if (reloc->r_type == GENERIC_RELOC_VANILLA) { + word = *wordPtr; + } #ifdef powerpc_HOST_ARCH - else if(reloc->r_type == PPC_RELOC_LO16) - { - word = ((unsigned short*) wordPtr)[1]; - word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16; - } - else if(reloc->r_type == PPC_RELOC_HI16) - { - word = ((unsigned short*) wordPtr)[1] << 16; - word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF); - } - else if(reloc->r_type == PPC_RELOC_HA16) - { - word = ((unsigned short*) wordPtr)[1] << 16; - word += ((short)relocs[i+1].r_address & (short)0xFFFF); - } - else if(reloc->r_type == PPC_RELOC_BR24) - { - word = *wordPtr; - word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0); - } + else if (reloc->r_type == PPC_RELOC_LO16) { + word = ((unsigned short*) wordPtr)[1]; + word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16; + } + else if (reloc->r_type == PPC_RELOC_HI16) { + word = ((unsigned short*) wordPtr)[1] << 16; + word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF); + } + else if (reloc->r_type == PPC_RELOC_HA16) { + word = ((unsigned short*) wordPtr)[1] << 16; + word += ((short)relocs[i+1].r_address & (short)0xFFFF); + } + else if (reloc->r_type == PPC_RELOC_BR24) { + word = *wordPtr; + word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0); + } #endif - else - { + else { barf("Can't handle this Mach-O relocation entry " - "(not scattered): " - "object file %s; entry type %ld; address %#lx\n", - oc->fileName, reloc->r_type, reloc->r_address); + "(not scattered): " + "object file %s; entry type %ld; address %#lx\n", + OC_INFORMATIVE_FILENAME(oc), + reloc->r_type, + reloc->r_address); return 0; } - if(!reloc->r_extern) - { - long delta = - sections[reloc->r_symbolnum-1].offset - - sections[reloc->r_symbolnum-1].addr - + ((long) image); - - word += delta; - } - else - { - struct nlist *symbol = &nlist[reloc->r_symbolnum]; - char *nm = image + symLC->stroff + symbol->n_un.n_strx; - void *symbolAddress = lookupSymbol(nm); - if(!symbolAddress) - { - errorBelch("\nunknown symbol `%s'", nm); - return 0; - } - - if(reloc->r_pcrel) - { + if (!reloc->r_extern) { + long delta = sections[reloc->r_symbolnum-1].offset + - sections[reloc->r_symbolnum-1].addr + + ((long) image); + + word += delta; + } + else { + struct nlist *symbol = &nlist[reloc->r_symbolnum]; + char *nm = image + symLC->stroff + symbol->n_un.n_strx; + void *symbolAddress = lookupSymbol(nm); + + if (!symbolAddress) { + errorBelch("\nunknown symbol `%s'", nm); + return 0; + } + + if (reloc->r_pcrel) { #ifdef powerpc_HOST_ARCH // In the .o file, this should be a relative jump to NULL // and we'll change it to a relative jump to the symbol @@ -4481,82 +5173,100 @@ static int relocateSection( reloc->r_symbolnum, (unsigned long) symbolAddress) -> jumpIsland; - if(jumpIsland != 0) - { + if (jumpIsland != 0) { offsetToJumpIsland = word + jumpIsland - (((long)image) + sect->offset - sect->addr); } #endif - word += (unsigned long) symbolAddress + word += (unsigned long) symbolAddress - (((long)image) + sect->offset - sect->addr); } - else - { + else { word += (unsigned long) symbolAddress; } - } + } - if(reloc->r_type == GENERIC_RELOC_VANILLA) - { - *wordPtr = word; - continue; - } + if (reloc->r_type == GENERIC_RELOC_VANILLA) { + *wordPtr = word; + continue; + } #ifdef powerpc_HOST_ARCH - else if(reloc->r_type == PPC_RELOC_LO16) - { - ((unsigned short*) wordPtr)[1] = word & 0xFFFF; - i++; continue; - } - else if(reloc->r_type == PPC_RELOC_HI16) - { - ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF; - i++; continue; - } - else if(reloc->r_type == PPC_RELOC_HA16) - { - ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF) - + ((word & (1<<15)) ? 1 : 0); - i++; continue; - } - else if(reloc->r_type == PPC_RELOC_BR24) - { - if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000) - { + else if(reloc->r_type == PPC_RELOC_LO16) + { + ((unsigned short*) wordPtr)[1] = word & 0xFFFF; + i++; + continue; + } + else if(reloc->r_type == PPC_RELOC_HI16) + { + ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF; + i++; + continue; + } + else if(reloc->r_type == PPC_RELOC_HA16) + { + ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF) + + ((word & (1<<15)) ? 1 : 0); + i++; + continue; + } + else if(reloc->r_type == PPC_RELOC_BR24) + { + if ((word & 0x03) != 0) { + barf("%s: unconditional relative branch with a displacement " + "which isn't a multiple of 4 bytes: %#lx", + OC_INFORMATIVE_FILENAME(oc), + word); + } + + if((word & 0xFE000000) != 0xFE000000 && + (word & 0xFE000000) != 0x00000000) { // The branch offset is too large. // Therefore, we try to use a jump island. - if(jumpIsland == 0) - { - barf("unconditional relative branch out of range: " - "no jump island available"); + if (jumpIsland == 0) { + barf("%s: unconditional relative branch out of range: " + "no jump island available: %#lx", + OC_INFORMATIVE_FILENAME(oc), + word); } - + word = offsetToJumpIsland; - if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000) - barf("unconditional relative branch out of range: " - "jump island out of range"); + + if((word & 0xFE000000) != 0xFE000000 && + (word & 0xFE000000) != 0x00000000) { + barf("%s: unconditional relative branch out of range: " + "jump island out of range: %#lx", + OC_INFORMATIVE_FILENAME(oc), + word); + } } - *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC); - continue; - } + *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC); + continue; + } #endif } else { - barf("Can't handle Mach-O relocation entry (not scattered) " + barf("Can't handle Mach-O relocation entry (not scattered) " "with this r_length tag: " "object file %s; entry type %ld; " - "r_length tag %ld; address %#lx\n", - oc->fileName, reloc->r_type, reloc->r_length, + "r_length tag %ld; address %#lx\n", + OC_INFORMATIVE_FILENAME(oc), + reloc->r_type, + reloc->r_length, reloc->r_address); - return 0; - } - } + return 0; + } + } #endif } + + IF_DEBUG(linker, debugBelch("relocateSection: done\n")); return 1; } -static int ocGetNames_MachO(ObjectCode* oc) +static int +ocGetNames_MachO(ObjectCode* oc) { char *image = (char*) oc->image; struct mach_header *header = (struct mach_header*) image; @@ -4570,26 +5280,37 @@ static int ocGetNames_MachO(ObjectCode* oc) char *commonStorage = NULL; unsigned long commonCounter; + IF_DEBUG(linker,debugBelch("ocGetNames_MachO: start\n")); + for(i=0;incmds;i++) { - if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64) - segLC = (struct segment_command*) lc; - else if(lc->cmd == LC_SYMTAB) - symLC = (struct symtab_command*) lc; - lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize ); + if (lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64) { + segLC = (struct segment_command*) lc; + } + else if (lc->cmd == LC_SYMTAB) { + symLC = (struct symtab_command*) lc; + } + + lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize ); } sections = (struct section*) (segLC+1); nlist = symLC ? (struct nlist*) (image + symLC->symoff) : NULL; - - if(!segLC) + + if (!segLC) { barf("ocGetNames_MachO: no segment load command"); + } + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: will load %d sections\n", segLC->nsects)); for(i=0;insects;i++) { - if(sections[i].size == 0) + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: section %d\n", i)); + + if (sections[i].size == 0) { + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: found a zero length section, skipping\n")); continue; + } if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL) { @@ -4598,36 +5319,47 @@ static int ocGetNames_MachO(ObjectCode* oc) sections[i].offset = zeroFillArea - image; } - if(!strcmp(sections[i].sectname,"__text")) - addSection(oc, SECTIONKIND_CODE_OR_RODATA, - (void*) (image + sections[i].offset), - (void*) (image + sections[i].offset + sections[i].size)); - else if(!strcmp(sections[i].sectname,"__const")) - addSection(oc, SECTIONKIND_RWDATA, - (void*) (image + sections[i].offset), - (void*) (image + sections[i].offset + sections[i].size)); - else if(!strcmp(sections[i].sectname,"__data")) - addSection(oc, SECTIONKIND_RWDATA, - (void*) (image + sections[i].offset), - (void*) (image + sections[i].offset + sections[i].size)); - else if(!strcmp(sections[i].sectname,"__bss") - || !strcmp(sections[i].sectname,"__common")) - addSection(oc, SECTIONKIND_RWDATA, - (void*) (image + sections[i].offset), - (void*) (image + sections[i].offset + sections[i].size)); - - addProddableBlock(oc, (void*) (image + sections[i].offset), + if (!strcmp(sections[i].sectname,"__text")) { + + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: adding __text section\n")); + addSection(oc, SECTIONKIND_CODE_OR_RODATA, + (void*) (image + sections[i].offset), + (void*) (image + sections[i].offset + sections[i].size)); + } + else if (!strcmp(sections[i].sectname,"__const")) { + + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: adding __const section\n")); + addSection(oc, SECTIONKIND_RWDATA, + (void*) (image + sections[i].offset), + (void*) (image + sections[i].offset + sections[i].size)); + } + else if (!strcmp(sections[i].sectname,"__data")) { + + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: adding __data section\n")); + addSection(oc, SECTIONKIND_RWDATA, + (void*) (image + sections[i].offset), + (void*) (image + sections[i].offset + sections[i].size)); + } + else if(!strcmp(sections[i].sectname,"__bss") + || !strcmp(sections[i].sectname,"__common")) { + + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: adding __bss section\n")); + addSection(oc, SECTIONKIND_RWDATA, + (void*) (image + sections[i].offset), + (void*) (image + sections[i].offset + sections[i].size)); + } + addProddableBlock(oc, + (void *) (image + sections[i].offset), sections[i].size); } - // count external symbols defined here + // count external symbols defined here oc->n_symbols = 0; - if(symLC) - { - for(i=0;insyms;i++) - { - if(nlist[i].n_type & N_STAB) + if (symLC) { + for (i = 0; i < symLC->nsyms; i++) { + if (nlist[i].n_type & N_STAB) { ; + } else if(nlist[i].n_type & N_EXT) { if((nlist[i].n_type & N_TYPE) == N_UNDF @@ -4641,8 +5373,9 @@ static int ocGetNames_MachO(ObjectCode* oc) } } } + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: %d external symbols\n", oc->n_symbols)); oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*), - "ocGetNames_MachO(oc->symbols)"); + "ocGetNames_MachO(oc->symbols)"); if(symLC) { @@ -4655,10 +5388,13 @@ static int ocGetNames_MachO(ObjectCode* oc) if(nlist[i].n_type & N_EXT) { char *nm = image + symLC->stroff + nlist[i].n_un.n_strx; - if((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm)) - ; // weak definition, and we already have a definition + if ((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm)) { + // weak definition, and we already have a definition + IF_DEBUG(linker, debugBelch(" weak: %s\n", nm)); + } else { + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting %s\n", nm)); ghciInsertStrHashTable(oc->fileName, symhash, nm, image + sections[nlist[i].n_sect-1].offset @@ -4667,36 +5403,48 @@ static int ocGetNames_MachO(ObjectCode* oc) oc->symbols[curSymbol++] = nm; } } + else + { + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: \t...not external, skipping\n")); + } + } + else + { + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: \t...not defined in this section, skipping\n")); } } } commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)"); commonCounter = (unsigned long)commonStorage; - if(symLC) - { - for(i=0;insyms;i++) - { - if((nlist[i].n_type & N_TYPE) == N_UNDF - && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0)) - { - char *nm = image + symLC->stroff + nlist[i].n_un.n_strx; - unsigned long sz = nlist[i].n_value; - nlist[i].n_value = commonCounter; + if (symLC) { + for (i = 0; i < symLC->nsyms; i++) { + if((nlist[i].n_type & N_TYPE) == N_UNDF + && (nlist[i].n_type & N_EXT) + && (nlist[i].n_value != 0)) { + + char *nm = image + symLC->stroff + nlist[i].n_un.n_strx; + unsigned long sz = nlist[i].n_value; - ghciInsertStrHashTable(oc->fileName, symhash, nm, - (void*)commonCounter); - oc->symbols[curSymbol++] = nm; + nlist[i].n_value = commonCounter; - commonCounter += sz; - } + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting common symbol: %s\n", nm)); + ghciInsertStrHashTable(oc->fileName, symhash, nm, + (void*)commonCounter); + oc->symbols[curSymbol++] = nm; + + commonCounter += sz; + } } } + + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: done\n")); return 1; } -static int ocResolve_MachO(ObjectCode* oc) +static int +ocResolve_MachO(ObjectCode* oc) { char *image = (char*) oc->image; struct mach_header *header = (struct mach_header*) image; @@ -4708,15 +5456,23 @@ static int ocResolve_MachO(ObjectCode* oc) struct dysymtab_command *dsymLC = NULL; struct nlist *nlist; - for(i=0;incmds;i++) + IF_DEBUG(linker, debugBelch("ocResolve_MachO: start\n")); + for (i = 0; i < header->ncmds; i++) { - if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64) - segLC = (struct segment_command*) lc; - else if(lc->cmd == LC_SYMTAB) - symLC = (struct symtab_command*) lc; - else if(lc->cmd == LC_DYSYMTAB) - dsymLC = (struct dysymtab_command*) lc; - lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize ); + if (lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64) { + segLC = (struct segment_command*) lc; + IF_DEBUG(linker, debugBelch("ocResolve_MachO: found a 32 or 64 bit segment load command\n")); + } + else if (lc->cmd == LC_SYMTAB) { + symLC = (struct symtab_command*) lc; + IF_DEBUG(linker, debugBelch("ocResolve_MachO: found a symbol table load command\n")); + } + else if (lc->cmd == LC_DYSYMTAB) { + dsymLC = (struct dysymtab_command*) lc; + IF_DEBUG(linker, debugBelch("ocResolve_MachO: found a dynamic symbol table load command\n")); + } + + lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize ); } sections = (struct section*) (segLC+1); @@ -4728,7 +5484,8 @@ static int ocResolve_MachO(ObjectCode* oc) unsigned long *indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff); - for(i=0;insects;i++) + IF_DEBUG(linker, debugBelch("ocResolve_MachO: resolving dsymLC\n")); + for (i = 0; i < segLC->nsects; i++) { if( !strcmp(sections[i].sectname,"__la_symbol_ptr") || !strcmp(sections[i].sectname,"__la_sym_ptr2") @@ -4748,13 +5505,19 @@ static int ocResolve_MachO(ObjectCode* oc) if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist)) return 0; } + else + { + IF_DEBUG(linker, debugBelch("ocResolve_MachO: unknown section\n")); + } } } - + for(i=0;insects;i++) { - if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i])) - return 0; + IF_DEBUG(linker, debugBelch("ocResolve_MachO: relocating section %d\n", i)); + + if (!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i])) + return 0; } #if defined (powerpc_HOST_ARCH) @@ -4776,7 +5539,8 @@ static int ocResolve_MachO(ObjectCode* oc) extern void* symbolsWithoutUnderscore[]; -static void machoInitSymbolsWithoutUnderscore() +static void +machoInitSymbolsWithoutUnderscore(void) { void **p = symbolsWithoutUnderscore; __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:"); @@ -4788,13 +5552,13 @@ static void machoInitSymbolsWithoutUnderscore() RTS_MACHO_NOUNDERLINE_SYMBOLS __asm__ volatile(".text"); - + #undef SymI_NeedsProto #define SymI_NeedsProto(x) \ ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++); - + RTS_MACHO_NOUNDERLINE_SYMBOLS - + #undef SymI_NeedsProto } #endif @@ -4804,20 +5568,30 @@ static void machoInitSymbolsWithoutUnderscore() * Figure out by how much to shift the entire Mach-O file in memory * when loading so that its single segment ends up 16-byte-aligned */ -static int machoGetMisalignment( FILE * f ) +static int +machoGetMisalignment( FILE * f ) { struct mach_header header; int misalignment; - - fread(&header, sizeof(header), 1, f); - rewind(f); -#if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH - if(header.magic != MH_MAGIC_64) - return 0; + { + int n = fread(&header, sizeof(header), 1, f); + if (n != 1) { + barf("machoGetMisalignment: can't read the Mach-O header"); + } + } + fseek(f, -sizeof(header), SEEK_CUR); + +#if x86_64_HOST_ARCH || powerpc64_HOST_ARCH + if(header.magic != MH_MAGIC_64) { + barf("Bad magic. Expected: %08x, got: %08x.", + MH_MAGIC_64, header.magic); + } #else - if(header.magic != MH_MAGIC) - return 0; + if(header.magic != MH_MAGIC) { + barf("Bad magic. Expected: %08x, got: %08x.", + MH_MAGIC, header.magic); + } #endif misalignment = (header.sizeofcmds + sizeof(header)) @@ -4828,4 +5602,3 @@ static int machoGetMisalignment( FILE * f ) #endif #endif -