X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FLinker.c;h=85d5809210524e1540380b85c3a5129bd699d6ef;hb=920a3de7d913f9f369ffb8e5f0892ef7c9aeacde;hp=a16dd00187f830b3fccebfe5aeeba6b3176bcd0b;hpb=52788cf58ddce3cd249dd9e07f57eddfaac7a3a6;p=ghc-hetmet.git diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c index a16dd00..85d5809 100644 --- a/ghc/rts/Linker.c +++ b/ghc/rts/Linker.c @@ -1,13 +1,14 @@ /* ----------------------------------------------------------------------------- - * $Id: Linker.c,v 1.68 2001/10/01 13:10:53 simonmar Exp $ * - * (c) The GHC Team, 2000, 2001 + * (c) The GHC Team, 2000-2003 * * RTS Object Linker * * ---------------------------------------------------------------------------*/ +#if 0 #include "PosixSource.h" +#endif #include "Rts.h" #include "RtsFlags.h" #include "HsFFI.h" @@ -22,23 +23,61 @@ #include #endif +#include +#include + #ifdef HAVE_SYS_STAT_H #include #endif -#ifdef HAVE_DLFCN_H +#if defined(HAVE_FRAMEWORK_HASKELLSUPPORT) +#include +#elif defined(HAVE_DLFCN_H) #include #endif -#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) +#if defined(cygwin32_TARGET_OS) +#ifdef HAVE_DIRENT_H +#include +#endif + +#ifdef HAVE_SYS_TIME_H +#include +#endif +#include +#include +#include +#include +#include +#include +#endif + +#if defined(ia64_TARGET_ARCH) +#define USE_MMAP +#include +#include +#endif + +#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS) || defined(openbsd_TARGET_OS) # define OBJFORMAT_ELF #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS) # define OBJFORMAT_PEi386 # include +# include +#elif defined(darwin_TARGET_OS) +# include +# define OBJFORMAT_MACHO +# include +# include +# include +# include #endif /* Hash table mapping symbol names to Symbol */ -/*Str*/HashTable *symhash; +static /*Str*/HashTable *symhash; + +/* List of currently loaded objects */ +ObjectCode *objects = NULL; /* initially empty */ #if defined(OBJFORMAT_ELF) static int ocVerifyImage_ELF ( ObjectCode* oc ); @@ -48,6 +87,13 @@ static int ocResolve_ELF ( ObjectCode* oc ); static int ocVerifyImage_PEi386 ( ObjectCode* oc ); static int ocGetNames_PEi386 ( ObjectCode* oc ); static int ocResolve_PEi386 ( ObjectCode* oc ); +#elif defined(OBJFORMAT_MACHO) +static int ocAllocateJumpIslands_MachO ( ObjectCode* oc ); +static int ocVerifyImage_MachO ( ObjectCode* oc ); +static int ocGetNames_MachO ( ObjectCode* oc ); +static int ocResolve_MachO ( ObjectCode* oc ); + +static void machoInitSymbolsWithoutUnderscore( void ); #endif /* ----------------------------------------------------------------------------- @@ -73,19 +119,117 @@ typedef struct _RtsSymbolVal { #endif #if !defined (mingw32_TARGET_OS) - #define RTS_POSIX_ONLY_SYMBOLS \ SymX(stg_sig_install) \ Sym(nocldstop) -#define RTS_MINGW_ONLY_SYMBOLS /**/ +#endif +#if defined (cygwin32_TARGET_OS) +#define RTS_MINGW_ONLY_SYMBOLS /**/ +/* Don't have the ability to read import libs / archives, so + * we have to stupidly list a lot of what libcygwin.a + * exports; sigh. + */ +#define RTS_CYGWIN_ONLY_SYMBOLS \ + SymX(regfree) \ + SymX(regexec) \ + SymX(regerror) \ + SymX(regcomp) \ + SymX(__errno) \ + SymX(access) \ + SymX(chmod) \ + SymX(chdir) \ + SymX(close) \ + SymX(creat) \ + SymX(dup) \ + SymX(dup2) \ + SymX(fstat) \ + SymX(fcntl) \ + SymX(getcwd) \ + SymX(getenv) \ + SymX(lseek) \ + SymX(open) \ + SymX(fpathconf) \ + SymX(pathconf) \ + SymX(stat) \ + SymX(pow) \ + SymX(tanh) \ + SymX(cosh) \ + SymX(sinh) \ + SymX(atan) \ + SymX(acos) \ + SymX(asin) \ + SymX(tan) \ + SymX(cos) \ + SymX(sin) \ + SymX(exp) \ + SymX(log) \ + SymX(sqrt) \ + SymX(localtime_r) \ + SymX(gmtime_r) \ + SymX(mktime) \ + Sym(_imp___tzname) \ + SymX(gettimeofday) \ + SymX(timezone) \ + SymX(tcgetattr) \ + SymX(tcsetattr) \ + SymX(memcpy) \ + SymX(memmove) \ + SymX(realloc) \ + SymX(malloc) \ + SymX(free) \ + SymX(fork) \ + SymX(lstat) \ + SymX(isatty) \ + SymX(mkdir) \ + SymX(opendir) \ + SymX(readdir) \ + SymX(rewinddir) \ + SymX(closedir) \ + SymX(link) \ + SymX(mkfifo) \ + SymX(pipe) \ + SymX(read) \ + SymX(rename) \ + SymX(rmdir) \ + SymX(select) \ + SymX(system) \ + SymX(write) \ + SymX(strcmp) \ + SymX(strcpy) \ + SymX(strncpy) \ + SymX(strerror) \ + SymX(sigaddset) \ + SymX(sigemptyset) \ + SymX(sigprocmask) \ + SymX(umask) \ + SymX(uname) \ + SymX(unlink) \ + SymX(utime) \ + SymX(waitpid) + +#elif !defined(mingw32_TARGET_OS) +#define RTS_MINGW_ONLY_SYMBOLS /**/ +#define RTS_CYGWIN_ONLY_SYMBOLS /**/ +#else /* defined(mingw32_TARGET_OS) */ +#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 \ + Sym(_imp____mb_cur_max) \ + Sym(_imp___pctype) #else - -#define RTS_POSIX_ONLY_SYMBOLS +#define RTS_MINGW_EXTRA_SYMS +#endif /* These are statically linked from the mingw libraries into the ghc executable, so we have to employ this hack. */ #define RTS_MINGW_ONLY_SYMBOLS \ + SymX(asyncReadzh_fast) \ + SymX(asyncWritezh_fast) \ + SymX(asyncDoProczh_fast) \ SymX(memset) \ SymX(inet_ntoa) \ SymX(inet_addr) \ @@ -142,50 +286,57 @@ typedef struct _RtsSymbolVal { Sym(_imp___iob) \ Sym(localtime) \ Sym(gmtime) \ - SymX(getenv) \ - SymX(free) \ - SymX(rename) \ Sym(opendir) \ Sym(readdir) \ - Sym(closedir) \ - SymX(GetCurrentProcess) \ - SymX(GetProcessTimes) \ - SymX(CloseHandle) \ - SymX(GetExitCodeProcess) \ - SymX(WaitForSingleObject) \ - SymX(CreateProcessA) \ - Sym(__divdi3) \ - Sym(__udivdi3) \ - Sym(__moddi3) \ - Sym(__umoddi3) \ - SymX(_errno) + Sym(rewinddir) \ + RTS_MINGW_EXTRA_SYMS \ + Sym(closedir) #endif +#ifndef SMP +# define MAIN_CAP_SYM SymX(MainCapability) +#else +# define MAIN_CAP_SYM +#endif #define RTS_SYMBOLS \ Maybe_ForeignObj \ Maybe_Stable_Names \ Sym(StgReturn) \ - Sym(__stginit_PrelGHC) \ - Sym(init_stack) \ - Sym(stg_chk_0) \ - Sym(stg_chk_1) \ - Sym(stg_enterStackTop) \ - Sym(stg_gc_d1) \ - Sym(stg_gc_enter_1) \ - Sym(stg_gc_f1) \ - Sym(stg_gc_noregs) \ - Sym(stg_gc_seq_1) \ - Sym(stg_gc_unbx_r1) \ - Sym(stg_gc_unpt_r1) \ - Sym(stg_gc_ut_0_1) \ - Sym(stg_gc_ut_1_0) \ - Sym(stg_gen_chk) \ - Sym(stg_yield_to_interpreter) \ + SymX(stg_enter_info) \ + SymX(stg_enter_ret) \ + SymX(stg_gc_void_info) \ + SymX(__stg_gc_enter_1) \ + SymX(stg_gc_noregs) \ + SymX(stg_gc_unpt_r1_info) \ + SymX(stg_gc_unpt_r1) \ + SymX(stg_gc_unbx_r1_info) \ + SymX(stg_gc_unbx_r1) \ + SymX(stg_gc_f1_info) \ + SymX(stg_gc_f1) \ + SymX(stg_gc_d1_info) \ + SymX(stg_gc_d1) \ + SymX(stg_gc_l1_info) \ + SymX(stg_gc_l1) \ + SymX(__stg_gc_fun) \ + SymX(stg_gc_fun_info) \ + SymX(stg_gc_fun_ret) \ + SymX(stg_gc_gen) \ + SymX(stg_gc_gen_info) \ + SymX(stg_gc_gen_hp) \ + SymX(stg_gc_ut) \ + SymX(stg_gen_yield) \ + SymX(stg_yield_noregs) \ + SymX(stg_yield_to_interpreter) \ + SymX(stg_gen_block) \ + SymX(stg_block_noregs) \ + SymX(stg_block_1) \ + SymX(stg_block_takemvar) \ + SymX(stg_block_putmvar) \ + SymX(stg_seq_frame_info) \ SymX(ErrorHdrHook) \ - SymX(MainRegTable) \ + MAIN_CAP_SYM \ SymX(MallocFailHook) \ - SymX(NoRunnableThreadsHook) \ SymX(OnExitHook) \ SymX(OutOfHeapHook) \ SymX(PatErrorHdrHook) \ @@ -207,36 +358,54 @@ typedef struct _RtsSymbolVal { SymX(catchzh_fast) \ SymX(cmp_thread) \ SymX(complementIntegerzh_fast) \ + SymX(cmpIntegerzh_fast) \ + SymX(cmpIntegerIntzh_fast) \ SymX(createAdjustor) \ SymX(decodeDoublezh_fast) \ SymX(decodeFloatzh_fast) \ SymX(defaultsHook) \ SymX(delayzh_fast) \ + SymX(deRefWeakzh_fast) \ + SymX(deRefStablePtrzh_fast) \ SymX(divExactIntegerzh_fast) \ SymX(divModIntegerzh_fast) \ SymX(forkzh_fast) \ + SymX(forkProcess) \ + SymX(forkOS_createThread) \ SymX(freeHaskellFunctionPtr) \ + SymX(freeStablePtr) \ SymX(gcdIntegerzh_fast) \ + SymX(gcdIntegerIntzh_fast) \ + SymX(gcdIntzh_fast) \ + SymX(genSymZh) \ SymX(getProgArgv) \ SymX(getStablePtr) \ SymX(int2Integerzh_fast) \ + SymX(integer2Intzh_fast) \ + SymX(integer2Wordzh_fast) \ + SymX(isCurrentThreadBoundzh_fast) \ SymX(isDoubleDenormalized) \ SymX(isDoubleInfinite) \ SymX(isDoubleNaN) \ SymX(isDoubleNegativeZero) \ + SymX(isEmptyMVarzh_fast) \ SymX(isFloatDenormalized) \ SymX(isFloatInfinite) \ SymX(isFloatNaN) \ SymX(isFloatNegativeZero) \ SymX(killThreadzh_fast) \ + SymX(makeStablePtrzh_fast) \ SymX(minusIntegerzh_fast) \ SymX(mkApUpd0zh_fast) \ + SymX(myThreadIdzh_fast) \ + SymX(labelThreadzh_fast) \ SymX(newArrayzh_fast) \ SymX(newBCOzh_fast) \ SymX(newByteArrayzh_fast) \ - SymX(newCAF) \ + SymX_redirect(newCAF, newDynCAF) \ SymX(newMVarzh_fast) \ SymX(newMutVarzh_fast) \ + SymX(atomicModifyMutVarzh_fast) \ SymX(newPinnedByteArrayzh_fast) \ SymX(orIntegerzh_fast) \ SymX(performGC) \ @@ -247,6 +416,7 @@ typedef struct _RtsSymbolVal { SymX(quotIntegerzh_fast) \ SymX(quotRemIntegerzh_fast) \ SymX(raisezh_fast) \ + SymX(raiseIOzh_fast) \ SymX(remIntegerzh_fast) \ SymX(resetNonBlockingFd) \ SymX(resumeThread) \ @@ -255,8 +425,8 @@ typedef struct _RtsSymbolVal { SymX(rts_eval) \ SymX(rts_evalIO) \ SymX(rts_evalLazyIO) \ + SymX(rts_evalStableIO) \ SymX(rts_eval_) \ - SymX(rts_getAddr) \ SymX(rts_getBool) \ SymX(rts_getChar) \ SymX(rts_getDouble) \ @@ -264,10 +434,12 @@ typedef struct _RtsSymbolVal { SymX(rts_getInt) \ SymX(rts_getInt32) \ SymX(rts_getPtr) \ + SymX(rts_getFunPtr) \ SymX(rts_getStablePtr) \ + SymX(rts_getThreadId) \ SymX(rts_getWord) \ SymX(rts_getWord32) \ - SymX(rts_mkAddr) \ + SymX(rts_lock) \ SymX(rts_mkBool) \ SymX(rts_mkChar) \ SymX(rts_mkDouble) \ @@ -278,6 +450,7 @@ typedef struct _RtsSymbolVal { SymX(rts_mkInt64) \ SymX(rts_mkInt8) \ SymX(rts_mkPtr) \ + SymX(rts_mkFunPtr) \ SymX(rts_mkStablePtr) \ SymX(rts_mkString) \ SymX(rts_mkWord) \ @@ -285,18 +458,55 @@ typedef struct _RtsSymbolVal { SymX(rts_mkWord32) \ SymX(rts_mkWord64) \ SymX(rts_mkWord8) \ + SymX(rts_unlock) \ + SymX(rtsSupportsBoundThreads) \ SymX(run_queue_hd) \ + SymX(__hscore_get_saved_termios) \ + SymX(__hscore_set_saved_termios) \ SymX(setProgArgv) \ + SymX(startupHaskell) \ + SymX(shutdownHaskell) \ SymX(shutdownHaskellAndExit) \ SymX(stable_ptr_table) \ SymX(stackOverflow) \ SymX(stg_CAF_BLACKHOLE_info) \ + SymX(stg_BLACKHOLE_BQ_info) \ + SymX(awakenBlockedQueue) \ SymX(stg_CHARLIKE_closure) \ SymX(stg_EMPTY_MVAR_info) \ SymX(stg_IND_STATIC_info) \ SymX(stg_INTLIKE_closure) \ SymX(stg_MUT_ARR_PTRS_FROZEN_info) \ SymX(stg_WEAK_info) \ + SymX(stg_ap_v_info) \ + SymX(stg_ap_f_info) \ + SymX(stg_ap_d_info) \ + SymX(stg_ap_l_info) \ + SymX(stg_ap_n_info) \ + SymX(stg_ap_p_info) \ + SymX(stg_ap_pv_info) \ + SymX(stg_ap_pp_info) \ + SymX(stg_ap_ppv_info) \ + SymX(stg_ap_ppp_info) \ + SymX(stg_ap_pppp_info) \ + SymX(stg_ap_ppppp_info) \ + SymX(stg_ap_pppppp_info) \ + SymX(stg_ap_ppppppp_info) \ + SymX(stg_ap_0_ret) \ + SymX(stg_ap_v_ret) \ + SymX(stg_ap_f_ret) \ + SymX(stg_ap_d_ret) \ + SymX(stg_ap_l_ret) \ + SymX(stg_ap_n_ret) \ + SymX(stg_ap_p_ret) \ + SymX(stg_ap_pv_ret) \ + SymX(stg_ap_pp_ret) \ + SymX(stg_ap_ppv_ret) \ + SymX(stg_ap_ppp_ret) \ + SymX(stg_ap_pppp_ret) \ + SymX(stg_ap_ppppp_ret) \ + SymX(stg_ap_pppppp_ret) \ + SymX(stg_ap_ppppppp_ret) \ SymX(stg_ap_1_upd_info) \ SymX(stg_ap_2_upd_info) \ SymX(stg_ap_3_upd_info) \ @@ -322,9 +532,7 @@ typedef struct _RtsSymbolVal { SymX(stg_sel_7_upd_info) \ SymX(stg_sel_8_upd_info) \ SymX(stg_sel_9_upd_info) \ - SymX(stg_seq_frame_info) \ SymX(stg_upd_frame_info) \ - SymX(stg_update_PAP) \ SymX(suspendThread) \ SymX(takeMVarzh_fast) \ SymX(timesIntegerzh_fast) \ @@ -338,23 +546,67 @@ typedef struct _RtsSymbolVal { SymX(xorIntegerzh_fast) \ SymX(yieldzh_fast) -#ifndef SUPPORT_LONG_LONGS -#define RTS_LONG_LONG_SYMS /* nothing */ -#else +#ifdef SUPPORT_LONG_LONGS #define RTS_LONG_LONG_SYMS \ SymX(int64ToIntegerzh_fast) \ SymX(word64ToIntegerzh_fast) -#endif /* SUPPORT_LONG_LONGS */ +#else +#define RTS_LONG_LONG_SYMS /* nothing */ +#endif + +#ifdef HAVE_TERMIOS_H +#define RTS_TERMIOS_SYMS \ + Sym(saved_termios) +#else +#define RTS_TERMIOS_SYMS /* nothing */ +#endif + +// 64-bit support functions in libgcc.a +#if defined(__GNUC__) && SIZEOF_VOID_P <= 4 +#define RTS_LIBGCC_SYMBOLS \ + Sym(__divdi3) \ + Sym(__udivdi3) \ + Sym(__moddi3) \ + Sym(__umoddi3) \ + Sym(__ashldi3) \ + Sym(__ashrdi3) \ + Sym(__lshrdi3) \ + Sym(__eprintf) +#elif defined(ia64_TARGET_ARCH) +#define RTS_LIBGCC_SYMBOLS \ + Sym(__divdi3) \ + Sym(__udivdi3) \ + Sym(__moddi3) \ + Sym(__umoddi3) \ + Sym(__divsf3) \ + Sym(__divdf3) +#else +#define RTS_LIBGCC_SYMBOLS +#endif + +#ifdef darwin_TARGET_OS + // 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 \ + Sym(saveFP) \ + Sym(restFP) +#endif /* entirely bogus claims about types of these symbols */ -#define Sym(vvv) extern void (vvv); +#define Sym(vvv) extern void vvv(void); #define SymX(vvv) /**/ +#define SymX_redirect(vvv,xxx) /**/ RTS_SYMBOLS RTS_LONG_LONG_SYMS RTS_POSIX_ONLY_SYMBOLS RTS_MINGW_ONLY_SYMBOLS +RTS_CYGWIN_ONLY_SYMBOLS +RTS_TERMIOS_SYMS +RTS_LIBGCC_SYMBOLS #undef Sym #undef SymX +#undef SymX_redirect #ifdef LEADING_UNDERSCORE #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s) @@ -366,18 +618,64 @@ RTS_MINGW_ONLY_SYMBOLS (void*)(&(vvv)) }, #define SymX(vvv) Sym(vvv) +// SymX_redirect allows us to redirect references to one symbol to +// another symbol. See newCAF/newDynCAF for an example. +#define SymX_redirect(vvv,xxx) \ + { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ + (void*)(&(xxx)) }, + static RtsSymbolVal rtsSyms[] = { RTS_SYMBOLS RTS_LONG_LONG_SYMS RTS_POSIX_ONLY_SYMBOLS RTS_MINGW_ONLY_SYMBOLS + RTS_CYGWIN_ONLY_SYMBOLS + RTS_LIBGCC_SYMBOLS { 0, 0 } /* sentinel */ }; /* ----------------------------------------------------------------------------- + * Insert symbols into hash tables, checking for duplicates. + */ +static void ghciInsertStrHashTable ( char* obj_name, + HashTable *table, + char* key, + void *data + ) +{ + if (lookupHashTable(table, (StgWord)key) == NULL) + { + insertStrHashTable(table, (StgWord)key, data); + return; + } + fprintf(stderr, + "\n\n" + "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n" + " %s\n" + "whilst processing object file\n" + " %s\n" + "This could be caused by:\n" + " * Loading two different object files which export the same symbol\n" + " * Specifying the same object file twice on the GHCi command line\n" + " * An incorrect `package.conf' entry, causing some object to be\n" + " loaded twice.\n" + "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n" + "\n", + (char*)key, + obj_name + ); + exit(1); +} + + +/* ----------------------------------------------------------------------------- * initialize the object linker */ -#if defined(OBJFORMAT_ELF) + + +static int linker_init_done = 0 ; + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) static void *dl_prog_handle; #endif @@ -386,27 +684,47 @@ initLinker( void ) { RtsSymbolVal *sym; + /* 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; + } + symhash = allocStrHashTable(); /* populate the symbol table with stuff from the RTS */ for (sym = rtsSyms; sym->lbl != NULL; sym++) { - insertStrHashTable(symhash, sym->lbl, sym->addr); + ghciInsertStrHashTable("(GHCi built-in symbols)", + symhash, sym->lbl, sym->addr); } -# if defined(OBJFORMAT_ELF) +# if defined(OBJFORMAT_MACHO) + machoInitSymbolsWithoutUnderscore(); +# endif + +# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) dl_prog_handle = dlopen(NULL, RTLD_LAZY); # endif } /* ----------------------------------------------------------------------------- + * Loading DLL or .so dynamic libraries + * ----------------------------------------------------------------------------- + * * Add a DLL from which symbols may be found. In the ELF case, just * do RTLD_GLOBAL-style add, so no further messing around needs to * happen in order that symbols in the loaded .so are findable -- * lookupSymbol() will subsequently see them by dlsym on the program's * dl-handle. Returns NULL if success, otherwise ptr to an err msg. * - * In the PEi386 case, open the DLLs and put handles to them in a + * In the PEi386 case, open the DLLs and put handles to them in a * linked list. When looking for a symbol, try all handles in the - * list. + * list. This means that we need to load even DLLs that are guaranteed + * to be in the ghc.exe image already, just so we can get a handle + * to give to loadSymbol, so that we can find the symbols. For such + * libraries, the LoadLibrary call should be a no-op except for returning + * the handle. + * */ #if defined(OBJFORMAT_PEi386) @@ -417,32 +735,25 @@ typedef char* name; struct _OpenedDLL* next; HINSTANCE instance; - } + } OpenedDLL; /* A list thereof. */ static OpenedDLL* opened_dlls = NULL; #endif - - -char* -addDLL ( __attribute((unused)) char* path, char* dll_name ) +char * +addDLL( char *dll_name ) { -# if defined(OBJFORMAT_ELF) +# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + /* ------------------- ELF DLL loader ------------------- */ void *hdl; - char *buf; char *errmsg; - if (path == NULL || strlen(path) == 0) { - buf = stgMallocBytes(strlen(dll_name) + 10, "addDll"); - sprintf(buf, "lib%s.so", dll_name); - } else { - buf = stgMallocBytes(strlen(path) + 1 + strlen(dll_name) + 10, "addDll"); - sprintf(buf, "%s/lib%s.so", path, dll_name); - } - hdl = dlopen(buf, RTLD_NOW | RTLD_GLOBAL ); - free(buf); + initLinker(); + + hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL); + if (hdl == NULL) { /* dlopen failed; return a ptr to the error msg. */ errmsg = dlerror(); @@ -454,14 +765,15 @@ addDLL ( __attribute((unused)) char* path, char* dll_name ) /*NOTREACHED*/ # elif defined(OBJFORMAT_PEi386) + /* ------------------- Win32 DLL loader ------------------- */ - /* Add this DLL to the list of DLLs in which to search for symbols. - The path argument is ignored. */ char* buf; OpenedDLL* o_dll; HINSTANCE instance; - /* fprintf(stderr, "\naddDLL; path=`%s', dll_name = `%s'\n", path, dll_name); */ + initLinker(); + + /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */ /* See if we've already got it, and ignore if so. */ for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { @@ -469,15 +781,32 @@ addDLL ( __attribute((unused)) char* path, char* dll_name ) return NULL; } + /* The file name has no suffix (yet) so that we can try + 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. */ + buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL"); sprintf(buf, "%s.DLL", dll_name); instance = LoadLibrary(buf); - free(buf); if (instance == NULL) { - /* LoadLibrary failed; return a ptr to the error msg. */ - return "addDLL: unknown error"; + sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv) + instance = LoadLibrary(buf); + if (instance == NULL) { + stgFree(buf); + + /* LoadLibrary failed; return a ptr to the error msg. */ + return "addDLL: unknown error"; + } } + stgFree(buf); + /* Add this DLL to the list of DLLs in which to search for symbols. */ o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" ); o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL"); strcpy(o_dll->name, dll_name); @@ -493,22 +822,30 @@ addDLL ( __attribute((unused)) char* path, char* dll_name ) /* ----------------------------------------------------------------------------- * lookup a symbol in the hash table - */ + */ void * lookupSymbol( char *lbl ) { void *val; + initLinker() ; ASSERT(symhash != NULL); val = lookupStrHashTable(symhash, lbl); if (val == NULL) { # if defined(OBJFORMAT_ELF) return dlsym(dl_prog_handle, lbl); +# elif defined(OBJFORMAT_MACHO) + if(NSIsSymbolNameDefined(lbl)) { + NSSymbol symbol = NSLookupAndBindSymbol(lbl); + return NSAddressOfSymbol(symbol); + } else { + return NULL; + } # elif defined(OBJFORMAT_PEi386) OpenedDLL* o_dll; void* sym; for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */ + /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */ if (lbl[0] == '_') { /* HACK: if the name has an initial underscore, try stripping it off & look that up first. I've yet to verify whether there's @@ -516,10 +853,16 @@ lookupSymbol( char *lbl ) stripped off when mapping from import lib name to the DLL name. */ sym = GetProcAddress(o_dll->instance, (lbl+1)); - if (sym != NULL) return sym; + if (sym != NULL) { + /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/ + return sym; + } } sym = GetProcAddress(o_dll->instance, lbl); - if (sym != NULL) return sym; + if (sym != NULL) { + /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/ + return sym; + } } return NULL; # else @@ -531,11 +874,13 @@ lookupSymbol( char *lbl ) } } -static +static +__attribute((unused)) void * lookupLocalSymbol( ObjectCode* oc, char *lbl ) { void *val; + initLinker() ; val = lookupStrHashTable(oc->lochash, lbl); if (val == NULL) { @@ -547,6 +892,50 @@ lookupLocalSymbol( ObjectCode* oc, char *lbl ) /* ----------------------------------------------------------------------------- + * Debugging aid: look in GHCi's object symbol tables for symbols + * within DELTA bytes of the specified address, and show their names. + */ +#ifdef DEBUG +void ghci_enquire ( char* addr ); + +void ghci_enquire ( char* addr ) +{ + int i; + char* sym; + char* a; + const int DELTA = 64; + ObjectCode* oc; + + initLinker(); + + for (oc = objects; oc; oc = oc->next) { + for (i = 0; i < oc->n_symbols; i++) { + sym = oc->symbols[i]; + if (sym == NULL) continue; + // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash); + a = NULL; + if (oc->lochash != NULL) { + a = lookupStrHashTable(oc->lochash, sym); + } + if (a == NULL) { + a = lookupStrHashTable(symhash, sym); + } + if (a == NULL) { + // fprintf(stderr, "ghci_enquire: can't find %s\n", sym); + } + else if (addr-DELTA <= a && a <= addr+DELTA) { + fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym); + } + } + } +} +#endif + +#ifdef ia64_TARGET_ARCH +static unsigned int PLTSize(void); +#endif + +/* ----------------------------------------------------------------------------- * Load an obj (populate the global symbol table, but don't resolve yet) * * Returns: 1 if ok, 0 on error. @@ -557,17 +946,37 @@ loadObj( char *path ) ObjectCode* oc; struct stat st; int r, n; +#ifdef USE_MMAP + int fd, pagesize; + void *map_addr; +#else FILE *f; +#endif + + initLinker(); /* fprintf(stderr, "loadObj %s\n", path ); */ -# ifdef DEBUG - /* assert that we haven't already loaded this object */ - { + + /* Check that we haven't already loaded this object. Don't give up + at this stage; ocGetNames_* will barf later. */ + { ObjectCode *o; - for (o = objects; o; o = o->next) - ASSERT(strcmp(o->fileName, path)); + int is_dup = 0; + for (o = objects; o; o = o->next) { + if (0 == strcmp(o->fileName, path)) + is_dup = 1; + } + if (is_dup) { + fprintf(stderr, + "\n\n" + "GHCi runtime linker: warning: looks like you're trying to load the\n" + "same object file twice:\n" + " %s\n" + "GHCi will continue, but a duplicate-symbol error may shortly follow.\n" + "\n" + , path); + } } -# endif /* DEBUG */ oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)"); @@ -575,8 +984,10 @@ loadObj( char *path ) oc->formatName = "ELF"; # elif defined(OBJFORMAT_PEi386) oc->formatName = "PEi386"; +# elif defined(OBJFORMAT_MACHO) + oc->formatName = "Mach-O"; # else - free(oc); + stgFree(oc); barf("loadObj: not implemented on this platform"); # endif @@ -588,7 +999,6 @@ loadObj( char *path ) strcpy(oc->fileName, path); oc->fileSize = st.st_size; - oc->image = stgMallocBytes( st.st_size, "loadObj(image)" ); oc->symbols = NULL; oc->sections = NULL; oc->lochash = allocStrHashTable(); @@ -598,22 +1008,64 @@ loadObj( char *path ) oc->next = objects; objects = oc; +#ifdef USE_MMAP +#define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1)) + + /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */ + + fd = open(path, O_RDONLY); + if (fd == -1) + barf("loadObj: can't open `%s'", path); + + pagesize = getpagesize(); + +#ifdef ia64_TARGET_ARCH + /* The PLT needs to be right before the object */ + n = ROUND_UP(PLTSize(), pagesize); + oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0); + if (oc->plt == MAP_FAILED) + barf("loadObj: can't allocate PLT"); + + oc->pltIndex = 0; + map_addr = oc->plt + n; +#endif + + n = ROUND_UP(oc->fileSize, pagesize); + oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0); + if (oc->image == MAP_FAILED) + barf("loadObj: can't map `%s'", path); + + close(fd); + +#else /* !USE_MMAP */ + + oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)"); + /* load the image into memory */ f = fopen(path, "rb"); - if (!f) { + if (!f) barf("loadObj: can't read `%s'", path); - } + n = fread ( oc->image, 1, oc->fileSize, f ); - if (n != oc->fileSize) { - fclose(f); + if (n != oc->fileSize) barf("loadObj: error whilst reading `%s'", path); - } + + fclose(f); + +#endif /* USE_MMAP */ + +# if defined(OBJFORMAT_MACHO) + r = ocAllocateJumpIslands_MachO ( oc ); + if (!r) { return r; } +#endif /* verify the in-memory image */ # if defined(OBJFORMAT_ELF) r = ocVerifyImage_ELF ( oc ); # elif defined(OBJFORMAT_PEi386) r = ocVerifyImage_PEi386 ( oc ); +# elif defined(OBJFORMAT_MACHO) + r = ocVerifyImage_MachO ( oc ); # else barf("loadObj: no verify method"); # endif @@ -624,6 +1076,8 @@ loadObj( char *path ) r = ocGetNames_ELF ( oc ); # elif defined(OBJFORMAT_PEi386) r = ocGetNames_PEi386 ( oc ); +# elif defined(OBJFORMAT_MACHO) + r = ocGetNames_MachO ( oc ); # else barf("loadObj: no getNames method"); # endif @@ -640,18 +1094,22 @@ loadObj( char *path ) * * Returns: 1 if ok, 0 on error. */ -HsInt +HsInt resolveObjs( void ) { ObjectCode *oc; int r; + initLinker(); + for (oc = objects; oc; oc = oc->next) { if (oc->status != OBJECT_RESOLVED) { # if defined(OBJFORMAT_ELF) r = ocResolve_ELF ( oc ); # elif defined(OBJFORMAT_PEi386) r = ocResolve_PEi386 ( oc ); +# elif defined(OBJFORMAT_MACHO) + r = ocResolve_MachO ( oc ); # else barf("resolveObjs: not implemented on this platform"); # endif @@ -673,6 +1131,8 @@ unloadObj( char *path ) ASSERT(symhash != NULL); ASSERT(objects != NULL); + initLinker(); + prev = NULL; for (oc = objects; oc; prev = oc, oc = oc->next) { if (!strcmp(oc->fileName,path)) { @@ -680,7 +1140,7 @@ unloadObj( char *path ) /* 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) { @@ -697,14 +1157,14 @@ unloadObj( char *path ) /* We're going to leave this in place, in case there are any pointers from the heap into it: */ - /* free(oc->image); */ - free(oc->fileName); - free(oc->symbols); - free(oc->sections); + /* stgFree(oc->image); */ + stgFree(oc->fileName); + stgFree(oc->symbols); + stgFree(oc->sections); /* The local hash table should have been freed at the end of the ocResolve_ call on it. */ ASSERT(oc->lochash == NULL); - free(oc); + stgFree(oc); return 1; } } @@ -720,7 +1180,7 @@ unloadObj( char *path ) */ static void addProddableBlock ( ObjectCode* oc, void* start, int size ) { - ProddableBlock* pb + ProddableBlock* pb = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock"); /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */ ASSERT(size > 0); @@ -757,6 +1217,10 @@ static void addSection ( ObjectCode* oc, SectionKind kind, s->kind = kind; s->next = oc->sections; oc->sections = s; + /* + fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n", + start, ((char*)end)-1, end - start + 1, kind ); + */ } @@ -765,13 +1229,40 @@ static void addSection ( ObjectCode* oc, SectionKind kind, * PEi386 specifics (Win32 targets) * ------------------------------------------------------------------------*/ -/* The information for this linker comes from - Microsoft Portable Executable +/* The information for this linker comes from + Microsoft Portable Executable and Common Object File Format Specification revision 5.1 January 1998 which SimonM says comes from the MS Developer Network CDs. + + It can be found there (on older CDs), but can also be found + online at: + + http://www.microsoft.com/hwdev/hardware/PECOFF.asp + + (this is Rev 6.0 from February 1999). + + Things move, so if that fails, try searching for it via + + http://www.google.com/search?q=PE+COFF+specification + + The ultimate reference for the PE format is the Winnt.h + header file that comes with the Platform SDKs; as always, + implementations will drift wrt their documentation. + + A good background article on the PE format is Matt Pietrek's + March 1994 article in Microsoft System Journal (MSJ) + (Vol.9, No. 3): "Peering Inside the PE: A Tour of the + Win32 Portable Executable File Format." The info in there + has recently been updated in a two part article in + MSDN magazine, issues Feb and March 2002, + "Inside Windows: An In-Depth Look into the Win32 Portable + Executable File Format" + + John Levine's book "Linkers and Loaders" contains useful + info on PE too. */ - + #if defined(OBJFORMAT_PEi386) @@ -783,7 +1274,7 @@ typedef unsigned int UInt32; typedef int Int32; -typedef +typedef struct { UInt16 Machine; UInt16 NumberOfSections; @@ -798,7 +1289,7 @@ typedef #define sizeof_COFF_header 20 -typedef +typedef struct { UChar Name[8]; UInt32 VirtualSize; @@ -809,7 +1300,7 @@ typedef UInt32 PointerToLinenumbers; UInt16 NumberOfRelocations; UInt16 NumberOfLineNumbers; - UInt32 Characteristics; + UInt32 Characteristics; } COFF_section; @@ -861,6 +1352,7 @@ typedef /* From PE spec doc, section 4.1 */ #define MYIMAGE_SCN_CNT_CODE 0x00000020 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040 +#define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000 /* From PE spec doc, section 5.2.1 */ #define MYIMAGE_REL_I386_DIR32 0x0006 @@ -869,7 +1361,7 @@ typedef /* We use myindex to calculate array addresses, rather than simply doing the normal subscript thing. That's because - some of the above structs have sizes which are not + some of the above structs have sizes which are not a whole number of words. GCC rounds their sizes up to a whole number of words, which means that the address calcs arising from using normal C indexing or pointer arithmetic @@ -924,7 +1416,7 @@ cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab ) { UChar* newstr; /* If the string is longer than 8 bytes, look in the - string table for it -- this will be correctly zero terminated. + string table for it -- this will be correctly zero terminated. */ if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) { UInt32 strtab_offset = * (UInt32*)(name+4); @@ -950,23 +1442,23 @@ static COFF_section * findPEi386SectionCalled ( ObjectCode* oc, char* name ) { int i; - COFF_header* hdr + COFF_header* hdr = (COFF_header*)(oc->image); - COFF_section* sectab + COFF_section* sectab = (COFF_section*) ( - ((UChar*)(oc->image)) + ((UChar*)(oc->image)) + sizeof_COFF_header + hdr->SizeOfOptionalHeader ); for (i = 0; i < hdr->NumberOfSections; i++) { UChar* n1; UChar* n2; - COFF_section* section_i + COFF_section* section_i = (COFF_section*) myindex ( sizeof_COFF_section, sectab, i ); n1 = (UChar*) &(section_i->Name); n2 = name; - if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] && - n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] && + if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] && + n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] && n1[6]==n2[6] && n1[7]==n2[7]) return section_i; } @@ -981,7 +1473,7 @@ zapTrailingAtSign ( UChar* sym ) # define my_isdigit(c) ((c) >= '0' && (c) <= '9') int i, j; if (sym[0] == 0) return; - i = 0; + i = 0; while (sym[i] != 0) i++; i--; j = i; @@ -994,7 +1486,8 @@ zapTrailingAtSign ( UChar* sym ) static int ocVerifyImage_PEi386 ( ObjectCode* oc ) { - int i, j; + int i; + UInt32 j, noRelocs; COFF_header* hdr; COFF_section* sectab; COFF_symbol* symtab; @@ -1002,12 +1495,12 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */ hdr = (COFF_header*)(oc->image); sectab = (COFF_section*) ( - ((UChar*)(oc->image)) + ((UChar*)(oc->image)) + sizeof_COFF_header + hdr->SizeOfOptionalHeader ); symtab = (COFF_symbol*) ( ((UChar*)(oc->image)) - + hdr->PointerToSymbolTable + + hdr->PointerToSymbolTable ); strtab = ((UChar*)symtab) + hdr->NumberOfSymbols * sizeof_COFF_symbol; @@ -1029,7 +1522,7 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) } if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI) /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) { - belch("Invalid PEi386 word size or endiannness: %d", + belch("Invalid PEi386 word size or endiannness: %d", (int)(hdr->Characteristics)); return 0; } @@ -1037,38 +1530,40 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) there are more than 64k relocations, despite claims to the contrary. Hence this test. */ /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */ - if (* (UInt32*)strtab > 600000) { +#if 0 + if ( (*(UInt32*)strtab) > 600000 ) { /* Note that 600k has no special significance other than being big enough to handle the almost-2MB-sized lumps that constitute HSwin32*.o. */ belch("PEi386 object has suspiciously large string table; > 64k relocs?"); return 0; } +#endif /* No further verification after this point; only debug printing. */ i = 0; IF_DEBUG(linker, i=1); if (i == 0) return 1; - fprintf ( stderr, + fprintf ( stderr, "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) ); - fprintf ( stderr, + fprintf ( stderr, "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) ); - fprintf ( stderr, + fprintf ( stderr, "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) ); fprintf ( stderr, "\n" ); - fprintf ( stderr, + fprintf ( stderr, "Machine: 0x%x\n", (UInt32)(hdr->Machine) ); - fprintf ( stderr, + fprintf ( stderr, "# sections: %d\n", (UInt32)(hdr->NumberOfSections) ); fprintf ( stderr, "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) ); fprintf ( stderr, "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) ); - fprintf ( stderr, + fprintf ( stderr, "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) ); - fprintf ( stderr, + fprintf ( stderr, "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) ); fprintf ( stderr, "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) ); @@ -1080,14 +1575,14 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) COFF_section* sectab_i = (COFF_section*) myindex ( sizeof_COFF_section, sectab, i ); - fprintf ( stderr, + fprintf ( stderr, "\n" "section %d\n" " name `", - i + i ); printName ( sectab_i->Name, strtab ); - fprintf ( stderr, + fprintf ( stderr, "'\n" " vsize %d\n" " vaddr %d\n" @@ -1108,16 +1603,32 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) ((UChar*)(oc->image)) + sectab_i->PointerToRelocations ); - for (j = 0; j < sectab_i->NumberOfRelocations; j++) { + 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). + */ + COFF_reloc* rel = (COFF_reloc*) + myindex ( sizeof_COFF_reloc, reltab, 0 ); + noRelocs = rel->VirtualAddress; + j = 1; + } else { + noRelocs = sectab_i->NumberOfRelocations; + j = 0; + } + + for (; j < noRelocs; j++) { COFF_symbol* sym; COFF_reloc* rel = (COFF_reloc*) myindex ( sizeof_COFF_reloc, reltab, j ); - fprintf ( stderr, + fprintf ( stderr, " type 0x%-4x vaddr 0x%-8x name `", - (UInt32)rel->Type, + (UInt32)rel->Type, rel->VirtualAddress ); sym = (COFF_symbol*) myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex ); + /* Hmm..mysterious looking offset - what's it for? SOF */ printName ( sym->Name, strtab -10 ); fprintf ( stderr, "'\n" ); } @@ -1128,8 +1639,8 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab ); fprintf ( stderr, "---START of string table---\n"); for (i = 4; i < *(Int32*)strtab; i++) { - if (strtab[i] == 0) - fprintf ( stderr, "\n"); else + if (strtab[i] == 0) + fprintf ( stderr, "\n"); else fprintf( stderr, "%c", strtab[i] ); } fprintf ( stderr, "--- END of string table---\n"); @@ -1141,13 +1652,13 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) if (i >= (Int32)(hdr->NumberOfSymbols)) break; symtab_i = (COFF_symbol*) myindex ( sizeof_COFF_symbol, symtab, i ); - fprintf ( stderr, + fprintf ( stderr, "symbol %d\n" " name `", - i + i ); printName ( symtab_i->Name, strtab ); - fprintf ( stderr, + fprintf ( stderr, "'\n" " value 0x%x\n" " 1+sec# %d\n" @@ -1158,7 +1669,7 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) (Int32)(symtab_i->SectionNumber), (UInt32)symtab_i->Type, (UInt32)symtab_i->StorageClass, - (UInt32)symtab_i->NumberOfAuxSymbols + (UInt32)symtab_i->NumberOfAuxSymbols ); i += symtab_i->NumberOfAuxSymbols; i++; @@ -1180,15 +1691,15 @@ ocGetNames_PEi386 ( ObjectCode* oc ) UChar* sname; void* addr; int i; - + hdr = (COFF_header*)(oc->image); sectab = (COFF_section*) ( - ((UChar*)(oc->image)) + ((UChar*)(oc->image)) + sizeof_COFF_header + hdr->SizeOfOptionalHeader ); symtab = (COFF_symbol*) ( ((UChar*)(oc->image)) - + hdr->PointerToSymbolTable + + hdr->PointerToSymbolTable ); strtab = ((UChar*)(oc->image)) + hdr->PointerToSymbolTable @@ -1206,7 +1717,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) /* This is a non-empty .bss section. Allocate zeroed space for it, and set its PointerToRawData field such that oc->image + PointerToRawData == addr_of_zeroed_space. */ - zspace = stgCallocBytes(1, sectab_i->VirtualSize, + zspace = stgCallocBytes(1, sectab_i->VirtualSize, "ocGetNames_PEi386(anonymous bss)"); sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image)); addProddableBlock(oc, zspace, sectab_i->VirtualSize); @@ -1220,7 +1731,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) UChar* end; UInt32 sz; - SectionKind kind + SectionKind kind = SECTIONKIND_OTHER; COFF_section* sectab_i = (COFF_section*) @@ -1228,11 +1739,11 @@ ocGetNames_PEi386 ( ObjectCode* oc ) IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name )); # if 0 - /* I'm sure this is the Right Way to do it. However, the + /* I'm sure this is the Right Way to do it. However, the alternative of testing the sectab_i->Name field seems to work ok with Cygwin. */ - if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE || + if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE || sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA) kind = SECTIONKIND_CODE_OR_RODATA; # endif @@ -1251,12 +1762,17 @@ ocGetNames_PEi386 ( ObjectCode* oc ) start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData; end = start + sz - 1; - if (kind == SECTIONKIND_OTHER) { + if (kind == SECTIONKIND_OTHER + /* Ignore sections called which contain stabs debugging + information. */ + && 0 != strcmp(".stab", sectab_i->Name) + && 0 != strcmp(".stabstr", sectab_i->Name) + ) { belch("Unknown PEi386 section name `%s'", sectab_i->Name); return 0; } - if (end >= start) { + if (kind != SECTIONKIND_OTHER && end >= start) { addSection(oc, kind, start, end); addProddableBlock(oc, start, end - start + 1); } @@ -1268,7 +1784,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*), "ocGetNames_PEi386(oc->symbols)"); /* Call me paranoid; I don't care. */ - for (i = 0; i < oc->n_symbols; i++) + for (i = 0; i < oc->n_symbols; i++) oc->symbols[i] = NULL; i = 0; @@ -1283,49 +1799,49 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) { /* This symbol is global and defined, viz, exported */ - /* for MYIMAGE_SYMCLASS_EXTERNAL + /* for MYIMAGE_SYMCLASS_EXTERNAL && !MYIMAGE_SYM_UNDEFINED, - the address of the symbol is: + the address of the symbol is: address of relevant section + offset in section */ - COFF_section* sectabent - = (COFF_section*) myindex ( sizeof_COFF_section, + COFF_section* sectabent + = (COFF_section*) myindex ( sizeof_COFF_section, sectab, symtab_i->SectionNumber-1 ); addr = ((UChar*)(oc->image)) + (sectabent->PointerToRawData + symtab_i->Value); - } + } else if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED && 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, + addr = stgCallocBytes(1, symtab_i->Value, "ocGetNames_PEi386(non-anonymous bss)"); - addSection(oc, SECTIONKIND_RWDATA, addr, + addSection(oc, SECTIONKIND_RWDATA, addr, ((UChar*)addr) + symtab_i->Value - 1); addProddableBlock(oc, addr, symtab_i->Value); /* fprintf(stderr, "BSS section at 0x%x\n", addr); */ } - if (addr != NULL) { + if (addr != NULL ) { sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab ); - /* fprintf(stderr,"addSymbol %p `%s'\n", addr,sname); */ + /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */ IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);) ASSERT(i >= 0 && i < oc->n_symbols); /* cstring_from_COFF_symbol_name always succeeds. */ oc->symbols[i] = sname; - insertStrHashTable(symhash, sname, addr); + ghciInsertStrHashTable(oc->fileName, symhash, sname, addr); } else { # if 0 - fprintf ( stderr, + fprintf ( stderr, "IGNORING symbol %d\n" " name `", - i + i ); printName ( symtab_i->Name, strtab ); - fprintf ( stderr, + fprintf ( stderr, "'\n" " value 0x%x\n" " 1+sec# %d\n" @@ -1336,7 +1852,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) (Int32)(symtab_i->SectionNumber), (UInt32)symtab_i->Type, (UInt32)symtab_i->StorageClass, - (UInt32)symtab_i->NumberOfAuxSymbols + (UInt32)symtab_i->NumberOfAuxSymbols ); # endif } @@ -1345,7 +1861,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) i++; } - return 1; + return 1; } @@ -1361,7 +1877,8 @@ ocResolve_PEi386 ( ObjectCode* oc ) UInt32 S; UInt32* pP; - int i, j; + int i; + UInt32 j, noRelocs; /* ToDo: should be variable-sized? But is at least safe in the sense of buffer-overrun-proof. */ @@ -1370,12 +1887,12 @@ ocResolve_PEi386 ( ObjectCode* oc ) hdr = (COFF_header*)(oc->image); sectab = (COFF_section*) ( - ((UChar*)(oc->image)) + ((UChar*)(oc->image)) + sizeof_COFF_header + hdr->SizeOfOptionalHeader ); symtab = (COFF_symbol*) ( ((UChar*)(oc->image)) - + hdr->PointerToSymbolTable + + hdr->PointerToSymbolTable ); strtab = ((UChar*)(oc->image)) + hdr->PointerToSymbolTable @@ -1389,16 +1906,45 @@ ocResolve_PEi386 ( ObjectCode* oc ) = (COFF_reloc*) ( ((UChar*)(oc->image)) + sectab_i->PointerToRelocations ); - for (j = 0; j < sectab_i->NumberOfRelocations; j++) { + + /* Ignore sections called which contain stabs debugging + information. */ + if (0 == strcmp(".stab", sectab_i->Name) + || 0 == strcmp(".stabstr", sectab_i->Name)) + continue; + + 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). + * + * 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; + fprintf(stderr, "WARNING: Overflown relocation field (# relocs found: %u)\n", noRelocs); fflush(stderr); + j = 1; + } else { + noRelocs = sectab_i->NumberOfRelocations; + j = 0; + } + + + for (; j < noRelocs; j++) { COFF_symbol* sym; - COFF_reloc* reltab_j + COFF_reloc* reltab_j = (COFF_reloc*) myindex ( sizeof_COFF_reloc, reltab, j ); /* the location to patch */ pP = (UInt32*)( - ((UChar*)(oc->image)) - + (sectab_i->PointerToRawData + ((UChar*)(oc->image)) + + (sectab_i->PointerToRawData + reltab_j->VirtualAddress - sectab_i->VirtualAddress ) ); @@ -1406,20 +1952,20 @@ ocResolve_PEi386 ( ObjectCode* oc ) A = *pP; /* the symbol to connect to */ sym = (COFF_symbol*) - myindex ( sizeof_COFF_symbol, + myindex ( sizeof_COFF_symbol, symtab, reltab_j->SymbolTableIndex ); IF_DEBUG(linker, - fprintf ( stderr, + fprintf ( stderr, "reloc sec %2d num %3d: type 0x%-4x " "vaddr 0x%-8x name `", i, j, - (UInt32)reltab_j->Type, + (UInt32)reltab_j->Type, reltab_j->VirtualAddress ); printName ( sym->Name, strtab ); fprintf ( stderr, "'\n" )); if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) { - COFF_section* section_sym + COFF_section* section_sym = findPEi386SectionCalled ( oc, sym->Name ); if (!section_sym) { belch("%s: can't find section `%s'", oc->fileName, sym->Name); @@ -1439,14 +1985,15 @@ ocResolve_PEi386 ( ObjectCode* oc ) if ((void*)S != NULL) goto foundit; (void*)S = lookupSymbol( symbol ); if ((void*)S != NULL) goto foundit; - belch("%s: unknown symbol `%s'", oc->fileName, symbol); + /* Newline first because the interactive linker has printed "linking..." */ + belch("\n%s: unknown symbol `%s'", oc->fileName, symbol); return 0; foundit: } checkProddableBlock(oc, pP); switch (reltab_j->Type) { - case MYIMAGE_REL_I386_DIR32: - *pP = A + S; + case MYIMAGE_REL_I386_DIR32: + *pP = A + S; break; case MYIMAGE_REL_I386_REL32: /* Tricky. We have to insert a displacement at @@ -1463,15 +2010,15 @@ ocResolve_PEi386 ( ObjectCode* oc ) ASSERT(A==0); *pP = S - ((UInt32)pP) - 4; break; - default: - belch("%s: unhandled PEi386 relocation type %d", + default: + belch("%s: unhandled PEi386 relocation type %d", oc->fileName, reltab_j->Type); return 0; } } } - + IF_DEBUG(linker, belch("completed %s", oc->fileName)); return 1; } @@ -1492,24 +2039,213 @@ ocResolve_PEi386 ( ObjectCode* oc ) # define ELF_TARGET_SPARC /* Used inside */ #elif defined(i386_TARGET_ARCH) # define ELF_TARGET_386 /* Used inside */ +#elif defined(x86_64_TARGET_ARCH) +# define ELF_TARGET_X64_64 +# define ELF_64BIT +#elif defined (ia64_TARGET_ARCH) +# define ELF_TARGET_IA64 /* Used inside */ +# define ELF_64BIT +# define ELF_FUNCTION_DESC /* calling convention uses function descriptors */ +# define ELF_NEED_GOT /* needs Global Offset Table */ +# define ELF_NEED_PLT /* needs Procedure Linkage Tables */ #endif -/* There is a similar case for IA64 in the Solaris2 headers if this - * ever becomes relevant. - */ +#if !defined(openbsd_TARGET_OS) #include +#else +/* openbsd elf has things in different places, with diff names */ +#include +#include +#define R_386_32 RELOC_32 +#define R_386_PC32 RELOC_PC32 +#endif + +/* + * Define a set of types which can be used for both ELF32 and ELF64 + */ + +#ifdef ELF_64BIT +#define ELFCLASS ELFCLASS64 +#define Elf_Addr Elf64_Addr +#define Elf_Word Elf64_Word +#define Elf_Sword Elf64_Sword +#define Elf_Ehdr Elf64_Ehdr +#define Elf_Phdr Elf64_Phdr +#define Elf_Shdr Elf64_Shdr +#define Elf_Sym Elf64_Sym +#define Elf_Rel Elf64_Rel +#define Elf_Rela Elf64_Rela +#define ELF_ST_TYPE ELF64_ST_TYPE +#define ELF_ST_BIND ELF64_ST_BIND +#define ELF_R_TYPE ELF64_R_TYPE +#define ELF_R_SYM ELF64_R_SYM +#else +#define ELFCLASS ELFCLASS32 +#define Elf_Addr Elf32_Addr +#define Elf_Word Elf32_Word +#define Elf_Sword Elf32_Sword +#define Elf_Ehdr Elf32_Ehdr +#define Elf_Phdr Elf32_Phdr +#define Elf_Shdr Elf32_Shdr +#define Elf_Sym Elf32_Sym +#define Elf_Rel Elf32_Rel +#define Elf_Rela Elf32_Rela +#ifndef ELF_ST_TYPE +#define ELF_ST_TYPE ELF32_ST_TYPE +#endif +#ifndef ELF_ST_BIND +#define ELF_ST_BIND ELF32_ST_BIND +#endif +#ifndef ELF_R_TYPE +#define ELF_R_TYPE ELF32_R_TYPE +#endif +#ifndef ELF_R_SYM +#define ELF_R_SYM ELF32_R_SYM +#endif +#endif + + +/* + * Functions to allocate entries in dynamic sections. Currently we simply + * preallocate a large number, and we don't check if a entry for the given + * target already exists (a linear search is too slow). Ideally these + * entries would be associated with symbols. + */ + +/* These sizes sufficient to load HSbase + HShaskell98 + a few modules */ +#define GOT_SIZE 0x20000 +#define FUNCTION_TABLE_SIZE 0x10000 +#define PLT_SIZE 0x08000 + +#ifdef ELF_NEED_GOT +static Elf_Addr got[GOT_SIZE]; +static unsigned int gotIndex; +static Elf_Addr gp_val = (Elf_Addr)got; + +static Elf_Addr +allocateGOTEntry(Elf_Addr target) +{ + Elf_Addr *entry; + + if (gotIndex >= GOT_SIZE) + barf("Global offset table overflow"); + + entry = &got[gotIndex++]; + *entry = target; + return (Elf_Addr)entry; +} +#endif + +#ifdef ELF_FUNCTION_DESC +typedef struct { + Elf_Addr ip; + Elf_Addr gp; +} FunctionDesc; + +static FunctionDesc functionTable[FUNCTION_TABLE_SIZE]; +static unsigned int functionTableIndex; + +static Elf_Addr +allocateFunctionDesc(Elf_Addr target) +{ + FunctionDesc *entry; + + if (functionTableIndex >= FUNCTION_TABLE_SIZE) + barf("Function table overflow"); + + entry = &functionTable[functionTableIndex++]; + entry->ip = target; + entry->gp = (Elf_Addr)gp_val; + return (Elf_Addr)entry; +} + +static Elf_Addr +copyFunctionDesc(Elf_Addr target) +{ + FunctionDesc *olddesc = (FunctionDesc *)target; + FunctionDesc *newdesc; + + newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip); + newdesc->gp = olddesc->gp; + return (Elf_Addr)newdesc; +} +#endif + +#ifdef ELF_NEED_PLT +#ifdef ia64_TARGET_ARCH +static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value); +static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc); + +static unsigned char plt_code[] = +{ + /* taken from binutils bfd/elfxx-ia64.c */ + 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */ + 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */ + 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */ + 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */ + 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */ + 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */ +}; + +/* If we can't get to the function descriptor via gp, take a local copy of it */ +#define PLT_RELOC(code, target) { \ + Elf64_Sxword rel_value = target - gp_val; \ + if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \ + ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \ + else \ + ia64_reloc_gprel22((Elf_Addr)code, target); \ + } +#endif + +typedef struct { + unsigned char code[sizeof(plt_code)]; +} PLTEntry; + +static Elf_Addr +allocatePLTEntry(Elf_Addr target, ObjectCode *oc) +{ + PLTEntry *plt = (PLTEntry *)oc->plt; + PLTEntry *entry; + + if (oc->pltIndex >= PLT_SIZE) + barf("Procedure table overflow"); + + entry = &plt[oc->pltIndex++]; + memcpy(entry->code, plt_code, sizeof(entry->code)); + PLT_RELOC(entry->code, target); + return (Elf_Addr)entry; +} + +static unsigned int +PLTSize(void) +{ + return (PLT_SIZE * sizeof(PLTEntry)); +} +#endif + + +/* + * Generic ELF functions + */ static char * -findElfSection ( void* objImage, Elf32_Word sh_type ) +findElfSection ( void* objImage, Elf_Word sh_type ) { - int i; char* ehdrC = (char*)objImage; - Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC; - Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff); + 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 && - i != ehdr->e_shstrndx) { + 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; } @@ -1517,35 +2253,50 @@ findElfSection ( void* objImage, Elf32_Word sh_type ) return ptr; } +#if defined(ia64_TARGET_ARCH) +static Elf_Addr +findElfSegment ( void* objImage, Elf_Addr vaddr ) +{ + char* ehdrC = (char*)objImage; + Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC; + Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff); + Elf_Addr segaddr = 0; + int i; + + for (i = 0; i < ehdr->e_phnum; i++) { + segaddr = phdr[i].p_vaddr; + if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz)) + break; + } + return segaddr; +} +#endif static int ocVerifyImage_ELF ( ObjectCode* oc ) { - Elf32_Shdr* shdr; - Elf32_Sym* stab; + Elf_Shdr* shdr; + Elf_Sym* stab; int i, j, nent, nstrtab, nsymtabs; char* sh_strtab; char* strtab; - char* ehdrC = (char*)(oc->image); - Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC; + char* ehdrC = (char*)(oc->image); + Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC; if (ehdr->e_ident[EI_MAG0] != ELFMAG0 || ehdr->e_ident[EI_MAG1] != ELFMAG1 || ehdr->e_ident[EI_MAG2] != ELFMAG2 || ehdr->e_ident[EI_MAG3] != ELFMAG3) { - belch("%s: not an ELF header", oc->fileName); + belch("%s: not an ELF object", oc->fileName); return 0; } - IF_DEBUG(linker,belch( "Is an ELF header" )); - if (ehdr->e_ident[EI_CLASS] != ELFCLASS32) { - belch("%s: not 32 bit ELF", oc->fileName); + if (ehdr->e_ident[EI_CLASS] != ELFCLASS) { + belch("%s: unsupported ELF format", oc->fileName); return 0; } - IF_DEBUG(linker,belch( "Is 32 bit ELF" )); - if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) { IF_DEBUG(linker,belch( "Is little-endian" )); } else @@ -1566,24 +2317,27 @@ ocVerifyImage_ELF ( ObjectCode* oc ) switch (ehdr->e_machine) { case EM_386: IF_DEBUG(linker,belch( "x86" )); break; case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break; - default: IF_DEBUG(linker,belch( "unknown" )); +#ifdef EM_IA_64 + case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break; +#endif + default: IF_DEBUG(linker,belch( "unknown" )); belch("%s: unknown architecture", oc->fileName); return 0; } IF_DEBUG(linker,belch( - "\nSection header table: start %d, n_entries %d, ent_size %d", + "\nSection header table: start %d, n_entries %d, ent_size %d", ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize )); - ASSERT (ehdr->e_shentsize == sizeof(Elf32_Shdr)); + ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr)); - shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff); + shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); if (ehdr->e_shstrndx == SHN_UNDEF) { belch("%s: no section header string table", oc->fileName); return 0; } else { - IF_DEBUG(linker,belch( "Section header string table is section %d", + IF_DEBUG(linker,belch( "Section header string table is section %d", ehdr->e_shstrndx)); sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset; } @@ -1594,7 +2348,7 @@ ocVerifyImage_ELF ( ObjectCode* oc ) IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size )); IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset )); IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ", - ehdrC + shdr[i].sh_offset, + ehdrC + shdr[i].sh_offset, ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1)); if (shdr[i].sh_type == SHT_REL) { @@ -1613,43 +2367,48 @@ ocVerifyImage_ELF ( ObjectCode* oc ) strtab = NULL; nstrtab = 0; for (i = 0; i < ehdr->e_shnum; i++) { - if (shdr[i].sh_type == SHT_STRTAB && - i != ehdr->e_shstrndx) { - IF_DEBUG(linker,belch(" section %d is a normal string table", 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 + debugging info. */ + && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8) + ) { + IF_DEBUG(linker,belch(" section %d is a normal string table", i )); strtab = ehdrC + shdr[i].sh_offset; nstrtab++; } - } + } if (nstrtab != 1) { belch("%s: no string tables, or too many", oc->fileName); return 0; } nsymtabs = 0; - IF_DEBUG(linker,belch( "\nSymbol tables" )); + IF_DEBUG(linker,belch( "\nSymbol tables" )); for (i = 0; i < ehdr->e_shnum; i++) { if (shdr[i].sh_type != SHT_SYMTAB) continue; IF_DEBUG(linker,belch( "section %d is a symbol table", i )); nsymtabs++; - stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset); - nent = shdr[i].sh_size / sizeof(Elf32_Sym); + stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset); + nent = shdr[i].sh_size / sizeof(Elf_Sym); IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)", nent, - shdr[i].sh_size % sizeof(Elf32_Sym) + shdr[i].sh_size % sizeof(Elf_Sym) )); - if (0 != shdr[i].sh_size % sizeof(Elf32_Sym)) { + if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) { belch("%s: non-integral number of symbol table entries", oc->fileName); return 0; } for (j = 0; j < nent; j++) { IF_DEBUG(linker,fprintf(stderr, " %2d ", j )); - IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ", + IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ", (int)stab[j].st_shndx, (int)stab[j].st_size, (char*)stab[j].st_value )); IF_DEBUG(linker,fprintf(stderr, "type=" )); - switch (ELF32_ST_TYPE(stab[j].st_info)) { + switch (ELF_ST_TYPE(stab[j].st_info)) { case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break; case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break; case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break; @@ -1660,7 +2419,7 @@ ocVerifyImage_ELF ( ObjectCode* oc ) IF_DEBUG(linker,fprintf(stderr, " " )); IF_DEBUG(linker,fprintf(stderr, "bind=" )); - switch (ELF32_ST_BIND(stab[j].st_info)) { + switch (ELF_ST_BIND(stab[j].st_info)) { case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break; case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break; case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break; @@ -1685,13 +2444,12 @@ static int ocGetNames_ELF ( ObjectCode* oc ) { int i, j, k, nent; - Elf32_Sym* stab; + Elf_Sym* stab; - char* ehdrC = (char*)(oc->image); - Elf32_Ehdr* ehdr = (Elf32_Ehdr*)ehdrC; - char* strtab = findElfSection ( ehdrC, SHT_STRTAB ); - Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset; + char* ehdrC = (char*)(oc->image); + Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC; + char* strtab = findElfSection ( ehdrC, SHT_STRTAB ); + Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); ASSERT(symhash != NULL); @@ -1702,45 +2460,66 @@ ocGetNames_ELF ( ObjectCode* oc ) k = 0; for (i = 0; i < ehdr->e_shnum; i++) { + /* Figure out what kind of section it is. Logic derived from + Figure 1.14 ("Special Sections") of the ELF document + ("Portable Formats Specification, Version 1.1"). */ + Elf_Shdr hdr = shdr[i]; + SectionKind kind = SECTIONKIND_OTHER; + int is_bss = FALSE; + + if (hdr.sh_type == SHT_PROGBITS + && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) { + /* .text-style section */ + kind = SECTIONKIND_CODE_OR_RODATA; + } + else + if (hdr.sh_type == SHT_PROGBITS + && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) { + /* .data-style section */ + kind = SECTIONKIND_RWDATA; + } + else + if (hdr.sh_type == SHT_PROGBITS + && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) { + /* .rodata-style section */ + kind = SECTIONKIND_CODE_OR_RODATA; + } + else + if (hdr.sh_type == SHT_NOBITS + && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) { + /* .bss-style section */ + kind = SECTIONKIND_RWDATA; + is_bss = TRUE; + } - /* make a section entry for relevant sections */ - SectionKind kind = SECTIONKIND_OTHER; - if (!strcmp(".data",sh_strtab+shdr[i].sh_name) || - !strcmp(".data1",sh_strtab+shdr[i].sh_name) || - !strcmp(".bss",sh_strtab+shdr[i].sh_name)) - kind = SECTIONKIND_RWDATA; - if (!strcmp(".text",sh_strtab+shdr[i].sh_name) || - !strcmp(".rodata",sh_strtab+shdr[i].sh_name) || - !strcmp(".rodata1",sh_strtab+shdr[i].sh_name)) - kind = SECTIONKIND_CODE_OR_RODATA; - - if (!strcmp(".bss",sh_strtab+shdr[i].sh_name) && shdr[i].sh_size > 0) { + if (is_bss && shdr[i].sh_size > 0) { /* This is a non-empty .bss section. Allocate zeroed space for - it, and set its .sh_offset field such that + it, and set its .sh_offset field such that ehdrC + .sh_offset == addr_of_zeroed_space. */ - char* zspace = stgCallocBytes(1, shdr[i].sh_size, + char* zspace = stgCallocBytes(1, shdr[i].sh_size, "ocGetNames_ELF(BSS)"); shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC); - /* - fprintf(stderr, "BSS section at 0x%x, size %d\n", + /* + fprintf(stderr, "BSS section at 0x%x, size %d\n", zspace, shdr[i].sh_size); */ } /* fill in the section info */ - addSection(oc, kind, ehdrC + shdr[i].sh_offset, - ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1); - if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) + if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) { addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size); + addSection(oc, kind, ehdrC + shdr[i].sh_offset, + ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1); + } if (shdr[i].sh_type != SHT_SYMTAB) continue; /* copy stuff into this module's object symbol table */ - stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset); - nent = shdr[i].sh_size / sizeof(Elf32_Sym); + stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset); + nent = shdr[i].sh_size / sizeof(Elf_Sym); oc->n_symbols = nent; - oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*), + oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*), "ocGetNames_ELF(oc->symbols)"); for (j = 0; j < nent; j++) { @@ -1757,15 +2536,15 @@ ocGetNames_ELF ( ObjectCode* oc ) isLocal = FALSE; ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)"); /* - fprintf(stderr, "COMMON symbol, size %d name %s\n", + fprintf(stderr, "COMMON symbol, size %d name %s\n", stab[j].st_size, nm); */ /* Pointless to do addProddableBlock() for this area, since the linker should never poke around in it. */ } else - if ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL - || ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL + 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 @@ -1773,25 +2552,30 @@ ocGetNames_ELF ( ObjectCode* oc ) && stab[j].st_shndx < SHN_LORESERVE && /* and it's a not a section or string table or anything silly */ - ( ELF32_ST_TYPE(stab[j].st_info)==STT_FUNC || - ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT || - ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE + ( 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 >=. */ ASSERT(secno > 0 && secno < ehdr->e_shnum); - /* + /* if (shdr[secno].sh_type == SHT_NOBITS) { - fprintf(stderr, " BSS symbol, size %d off %d name %s\n", + fprintf(stderr, " BSS symbol, size %d off %d name %s\n", stab[j].st_size, stab[j].st_value, nm); } */ ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value; - if (ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL) { - IF_DEBUG(linker,belch( "addOTabName(LOCL): %10p %s %s", - ad, oc->fileName, nm )); + if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) { isLocal = TRUE; } 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 */ + if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC) + ad = (char *)allocateFunctionDesc((Elf_Addr)ad); +#endif IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s", ad, oc->fileName, nm )); isLocal = FALSE; @@ -1805,19 +2589,19 @@ ocGetNames_ELF ( ObjectCode* oc ) oc->symbols[j] = nm; /* Acquire! */ if (isLocal) { - insertStrHashTable(oc->lochash, nm, ad); + /* Ignore entirely. */ } else { - insertStrHashTable(symhash, nm, ad); + ghciInsertStrHashTable(oc->fileName, symhash, nm, ad); } } else { /* Skip. */ - IF_DEBUG(linker,belch( "skipping `%s'", + IF_DEBUG(linker,belch( "skipping `%s'", strtab + stab[j].st_name )); /* - fprintf(stderr, + fprintf(stderr, "skipping bind = %d, type = %d, shndx = %d `%s'\n", - (int)ELF32_ST_BIND(stab[j].st_info), - (int)ELF32_ST_TYPE(stab[j].st_info), + (int)ELF_ST_BIND(stab[j].st_info), + (int)ELF_ST_TYPE(stab[j].st_info), (int)stab[j].st_shndx, strtab + stab[j].st_name ); @@ -1831,71 +2615,78 @@ ocGetNames_ELF ( ObjectCode* oc ) return 1; } - /* Do ELF relocations which lack an explicit addend. All x86-linux relocations appear to be of this form. */ static int -do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC, - Elf32_Shdr* shdr, int shnum, - Elf32_Sym* stab, char* strtab ) +do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, + Elf_Shdr* shdr, int shnum, + Elf_Sym* stab, char* strtab ) { int j; char *symbol; - Elf32_Word* targ; - Elf32_Rel* rtab = (Elf32_Rel*) (ehdrC + shdr[shnum].sh_offset); - int nent = shdr[shnum].sh_size / sizeof(Elf32_Rel); + Elf_Word* targ; + Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset); + int nent = shdr[shnum].sh_size / sizeof(Elf_Rel); int target_shndx = shdr[shnum].sh_info; int symtab_shndx = shdr[shnum].sh_link; - stab = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset); - targ = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset); + + stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset); + targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset); IF_DEBUG(linker,belch( "relocations for section %d using symtab %d", target_shndx, symtab_shndx )); + for (j = 0; j < nent; j++) { - Elf32_Addr offset = rtab[j].r_offset; - Elf32_Word info = rtab[j].r_info; + Elf_Addr offset = rtab[j].r_offset; + Elf_Addr info = rtab[j].r_info; - Elf32_Addr P = ((Elf32_Addr)targ) + offset; - Elf32_Word* pP = (Elf32_Word*)P; - Elf32_Addr A = *pP; - Elf32_Addr S; + Elf_Addr P = ((Elf_Addr)targ) + offset; + Elf_Word* pP = (Elf_Word*)P; + Elf_Addr A = *pP; + Elf_Addr S; + Elf_Addr value; - IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)", + IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)", j, (void*)offset, (void*)info )); if (!info) { IF_DEBUG(linker,belch( " ZERO" )); S = 0; } else { - /* First see if it is a nameless local symbol. */ - if (stab[ ELF32_R_SYM(info)].st_name == 0) { - symbol = "(noname)"; - S = (Elf32_Addr) - (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset - + stab[ELF32_R_SYM(info)].st_value); - } else { - /* No? Should be in a symbol table then; first try the - local one. */ - symbol = strtab+stab[ ELF32_R_SYM(info)].st_name; - (void*)S = lookupLocalSymbol( oc, symbol ); - if ((void*)S == NULL) - (void*)S = lookupSymbol( symbol ); - } + Elf_Sym sym = stab[ELF_R_SYM(info)]; + /* 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. */ + symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name; + S = (Elf_Addr) + (ehdrC + shdr[ sym.st_shndx ].sh_offset + + stab[ELF_R_SYM(info)].st_value); + + } else { + /* No, so look up the name in our global table. */ + symbol = strtab + sym.st_name; + (void*)S = lookupSymbol( symbol ); + } if (!S) { belch("%s: unknown symbol `%s'", oc->fileName, symbol); return 0; } IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S )); } + IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p", - (void*)P, (void*)S, (void*)A )); + (void*)P, (void*)S, (void*)A )); checkProddableBlock ( oc, pP ); - switch (ELF32_R_TYPE(info)) { + + value = S + A; + + switch (ELF_R_TYPE(info)) { # ifdef i386_TARGET_ARCH - case R_386_32: *pP = S + A; break; - case R_386_PC32: *pP = S + A - P; break; + case R_386_32: *pP = value; break; + case R_386_PC32: *pP = value - P; break; # endif - default: + default: belch("%s: unhandled ELF relocation(Rel) type %d\n", - oc->fileName, ELF32_R_TYPE(info)); + oc->fileName, ELF_R_TYPE(info)); return 0; } @@ -1903,114 +2694,162 @@ do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC, return 1; } - /* Do ELF relocations for which explicit addends are supplied. sparc-solaris relocations appear to be of this form. */ static int -do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC, - Elf32_Shdr* shdr, int shnum, - Elf32_Sym* stab, char* strtab ) +do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, + Elf_Shdr* shdr, int shnum, + Elf_Sym* stab, char* strtab ) { int j; char *symbol; - Elf32_Word* targ; - Elf32_Rela* rtab = (Elf32_Rela*) (ehdrC + shdr[shnum].sh_offset); - int nent = shdr[shnum].sh_size / sizeof(Elf32_Rela); + Elf_Addr targ; + Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset); + int nent = shdr[shnum].sh_size / sizeof(Elf_Rela); int target_shndx = shdr[shnum].sh_info; int symtab_shndx = shdr[shnum].sh_link; - stab = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset); - targ = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset); + + stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset); + targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset); IF_DEBUG(linker,belch( "relocations for section %d using symtab %d", target_shndx, symtab_shndx )); + for (j = 0; j < nent; j++) { - Elf32_Addr offset = rtab[j].r_offset; - Elf32_Word info = rtab[j].r_info; - Elf32_Sword addend = rtab[j].r_addend; - Elf32_Addr P = ((Elf32_Addr)targ) + offset; - Elf32_Addr A = addend; - Elf32_Addr S; -# if defined(sparc_TARGET_ARCH) +#if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH) /* This #ifdef only serves to avoid unused-var warnings. */ - Elf32_Word* pP = (Elf32_Word*)P; - Elf32_Word w1, w2; + Elf_Addr offset = rtab[j].r_offset; + Elf_Addr P = targ + offset; +#endif + Elf_Addr info = rtab[j].r_info; + Elf_Addr A = rtab[j].r_addend; + Elf_Addr S; + Elf_Addr value; +# if defined(sparc_TARGET_ARCH) + Elf_Word* pP = (Elf_Word*)P; + Elf_Word w1, w2; +# elif defined(ia64_TARGET_ARCH) + Elf64_Xword *pP = (Elf64_Xword *)P; + Elf_Addr addr; # endif - IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ", - j, (void*)offset, (void*)info, - (void*)addend )); + IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ", + j, (void*)offset, (void*)info, + (void*)A )); if (!info) { IF_DEBUG(linker,belch( " ZERO" )); S = 0; } else { - /* First see if it is a nameless local symbol. */ - if (stab[ ELF32_R_SYM(info)].st_name == 0) { - symbol = "(noname)"; - S = (Elf32_Addr) - (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset - + stab[ELF32_R_SYM(info)].st_value); - } else { - /* No? Should be in a symbol table then; first try the - local one. */ - symbol = strtab+stab[ ELF32_R_SYM(info)].st_name; - (void*)S = lookupLocalSymbol( oc, symbol ); - if ((void*)S == NULL) - (void*)S = lookupSymbol( symbol ); - } + Elf_Sym sym = stab[ELF_R_SYM(info)]; + /* 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. */ + symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name; + S = (Elf_Addr) + (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 */ + if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) { + S = allocateFunctionDesc(S + A); + A = 0; + } +#endif + } else { + /* No, so look up the name in our global table. */ + symbol = strtab + sym.st_name; + (void*)S = lookupSymbol( symbol ); + +#ifdef ELF_FUNCTION_DESC + /* 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)) + belch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A); +#endif + } if (!S) { belch("%s: unknown symbol `%s'", oc->fileName, symbol); return 0; - /* - S = 0x11223344; - fprintf ( stderr, "S %p A %p S+A %p S+A-P %p\n",S,A,S+A,S+A-P); - */ } IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S )); } + IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n", - (void*)P, (void*)S, (void*)A )); - checkProddableBlock ( oc, (void*)P ); - switch (ELF32_R_TYPE(info)) { + (void*)P, (void*)S, (void*)A )); + /* checkProddableBlock ( oc, (void*)P ); */ + + value = S + A; + + switch (ELF_R_TYPE(info)) { # if defined(sparc_TARGET_ARCH) - case R_SPARC_WDISP30: + case R_SPARC_WDISP30: w1 = *pP & 0xC0000000; - w2 = (Elf32_Word)((S + A - P) >> 2); + w2 = (Elf_Word)((value - P) >> 2); ASSERT((w2 & 0xC0000000) == 0); w1 |= w2; *pP = w1; break; case R_SPARC_HI22: w1 = *pP & 0xFFC00000; - w2 = (Elf32_Word)((S + A) >> 10); + w2 = (Elf_Word)(value >> 10); ASSERT((w2 & 0xFFC00000) == 0); w1 |= w2; *pP = w1; break; case R_SPARC_LO10: w1 = *pP & ~0x3FF; - w2 = (Elf32_Word)((S + A) & 0x3FF); + w2 = (Elf_Word)(value & 0x3FF); ASSERT((w2 & ~0x3FF) == 0); w1 |= w2; *pP = w1; break; /* According to the Sun documentation: - R_SPARC_UA32 + R_SPARC_UA32 This relocation type resembles R_SPARC_32, except it refers to an unaligned word. That is, the word to be relocated must be treated as four separate bytes with arbitrary alignment, not as a word aligned according to the architecture requirements. (JRS: which means that freeloading on the R_SPARC_32 case - is probably wrong, but hey ...) + is probably wrong, but hey ...) */ case R_SPARC_UA32: case R_SPARC_32: - w2 = (Elf32_Word)(S + A); + w2 = (Elf_Word)value; *pP = w2; break; +# elif defined(ia64_TARGET_ARCH) + case R_IA64_DIR64LSB: + case R_IA64_FPTR64LSB: + *pP = value; + break; + case R_IA64_PCREL64LSB: + *pP = value - P; + break; + case R_IA64_SEGREL64LSB: + addr = findElfSegment(ehdrC, value); + *pP = value - addr; + break; + case R_IA64_GPREL22: + ia64_reloc_gprel22(P, value); + break; + case R_IA64_LTOFF22: + case R_IA64_LTOFF22X: + case R_IA64_LTOFF_FPTR22: + addr = allocateGOTEntry(value); + ia64_reloc_gprel22(P, addr); + break; + case R_IA64_PCREL21B: + ia64_reloc_pcrel21(P, S, oc); + break; + case R_IA64_LDXMOV: + /* This goes with R_IA64_LTOFF22X and points to the load to + * convert into a move. We don't implement relaxation. */ + break; # endif - default: + default: belch("%s: unhandled ELF relocation(RelA) type %d\n", - oc->fileName, ELF32_R_TYPE(info)); + oc->fileName, ELF_R_TYPE(info)); return 0; } @@ -2018,39 +2857,47 @@ do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC, return 1; } - static int ocResolve_ELF ( ObjectCode* oc ) { char *strtab; int shnum, ok; - Elf32_Sym* stab = NULL; - char* ehdrC = (char*)(oc->image); - Elf32_Ehdr* ehdr = (Elf32_Ehdr*) ehdrC; - Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff); + Elf_Sym* stab = NULL; + char* ehdrC = (char*)(oc->image); + 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; /* first find "the" symbol table */ - stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB ); + stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB ); /* also go find the string table */ strtab = findElfSection ( ehdrC, SHT_STRTAB ); if (stab == NULL || strtab == NULL) { belch("%s: can't find string or symbol table", oc->fileName); - return 0; + return 0; } /* Process the relocation sections. */ for (shnum = 0; shnum < ehdr->e_shnum; shnum++) { + + /* Skip sections called ".rel.stab". These appear to contain + relocation entries that, when done, make the stabs debugging + info point at the right places. We ain't interested in all + dat jazz, mun. */ + if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9)) + continue; + if (shdr[shnum].sh_type == SHT_REL ) { - ok = do_Elf32_Rel_relocations ( oc, ehdrC, shdr, - shnum, stab, strtab ); + ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr, + shnum, stab, strtab ); if (!ok) return ok; } else if (shdr[shnum].sh_type == SHT_RELA) { - ok = do_Elf32_Rela_relocations ( oc, ehdrC, shdr, - shnum, stab, strtab ); + ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr, + shnum, stab, strtab ); if (!ok) return ok; } } @@ -2062,5 +2909,682 @@ ocResolve_ELF ( ObjectCode* oc ) return 1; } +/* + * IA64 specifics + * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template + * at the front. The following utility functions pack and unpack instructions, and + * take care of the most common relocations. + */ + +#ifdef ia64_TARGET_ARCH + +static Elf64_Xword +ia64_extract_instruction(Elf64_Xword *target) +{ + Elf64_Xword w1, w2; + int slot = (Elf_Addr)target & 3; + (Elf_Addr)target &= ~3; + + w1 = *target; + w2 = *(target+1); + + switch (slot) + { + case 0: + return ((w1 >> 5) & 0x1ffffffffff); + case 1: + return (w1 >> 46) | ((w2 & 0x7fffff) << 18); + case 2: + return (w2 >> 23); + default: + barf("ia64_extract_instruction: invalid slot %p", target); + } +} + +static void +ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value) +{ + int slot = (Elf_Addr)target & 3; + (Elf_Addr)target &= ~3; + + switch (slot) + { + case 0: + *target |= value << 5; + break; + case 1: + *target |= value << 46; + *(target+1) |= value >> 18; + break; + case 2: + *(target+1) |= value << 23; + break; + } +} + +static void +ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value) +{ + Elf64_Xword instruction; + Elf64_Sxword rel_value; + + rel_value = value - gp_val; + if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) + barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val); + + instruction = ia64_extract_instruction((Elf64_Xword *)target); + instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */ + | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */ + | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */ + | ((Elf64_Xword)(rel_value < 0) << 36); /* s */ + ia64_deposit_instruction((Elf64_Xword *)target, instruction); +} + +static void +ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc) +{ + Elf64_Xword instruction; + Elf64_Sxword rel_value; + Elf_Addr entry; + + entry = allocatePLTEntry(value, oc); + + rel_value = (entry >> 4) - (target >> 4); + if ((rel_value > 0xfffff) || (rel_value < -0xfffff)) + barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target); + + instruction = ia64_extract_instruction((Elf64_Xword *)target); + instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */ + | ((Elf64_Xword)(rel_value < 0) << 36); /* s */ + ia64_deposit_instruction((Elf64_Xword *)target, instruction); +} + +#endif /* ia64 */ #endif /* ELF */ + +/* -------------------------------------------------------------------------- + * Mach-O specifics + * ------------------------------------------------------------------------*/ + +#if defined(OBJFORMAT_MACHO) + +/* + Support for MachO linking on Darwin/MacOS X on PowerPC chips + by Wolfgang Thaller (wolfgang.thaller@gmx.net) + + I hereby formally apologize for the hackish nature of this code. + Things that need to be done: + *) implement ocVerifyImage_MachO + *) add still more sanity checks. +*/ + + +/* + ocAllocateJumpIslands_MachO + + Allocate additional space at the end of the object file image to make room + for jump islands. + + 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 + the jump to a short piece of new code that just loads the 32bit absolute + address and jumps there. + This function just allocates space for one 16 byte jump island for every + undefined symbol in the object file. The code for the islands is filled in by + makeJumpIsland below. +*/ + +static const int islandSize = 16; + +static int ocAllocateJumpIslands_MachO(ObjectCode* oc) +{ + char *image = (char*) oc->image; + struct mach_header *header = (struct mach_header*) image; + struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header)); + unsigned i; + + for(i=0;incmds;i++) + { + if(lc->cmd == LC_DYSYMTAB) + { + struct dysymtab_command *dsymLC = (struct dysymtab_command*) lc; + unsigned long nundefsym = dsymLC->nundefsym; + oc->island_start_symbol = dsymLC->iundefsym; + oc->n_islands = nundefsym; + + if(nundefsym > 0) + { +#ifdef USE_MMAP + #error ocAllocateJumpIslands_MachO doesnt want USE_MMAP to be defined +#else + oc->image = stgReallocBytes( + image, oc->fileSize + islandSize * nundefsym, + "ocAllocateJumpIslands_MachO"); +#endif + oc->jump_islands = oc->image + oc->fileSize; + memset(oc->jump_islands, 0, islandSize * nundefsym); + } + + break; // there can be only one LC_DSYMTAB + } + lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize ); + } + return 1; +} + +static int ocVerifyImage_MachO(ObjectCode* oc) +{ + // FIXME: do some verifying here + return 1; +} + +static int resolveImports( + ObjectCode* oc, + char *image, + struct symtab_command *symLC, + struct section *sect, // ptr to lazy or non-lazy symbol pointer section + unsigned long *indirectSyms, + struct nlist *nlist) +{ + unsigned i; + + for(i=0;i*4size;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 if((addr = lookupLocalSymbol(oc,nm)) != NULL) + ; + else + addr = lookupSymbol(nm); + if(!addr) + { + belch("\n%s: unknown symbol `%s'", oc->fileName, nm); + return 0; + } + ASSERT(addr); + checkProddableBlock(oc,((void**)(image + sect->offset)) + i); + ((void**)(image + sect->offset))[i] = addr; + } + + return 1; +} + +static void* makeJumpIsland( + ObjectCode* oc, + unsigned long symbolNumber, + void* target) +{ + if(symbolNumber < oc->island_start_symbol || + symbolNumber - oc->island_start_symbol > oc->n_islands) + return NULL; + symbolNumber -= oc->island_start_symbol; + + void *island = (void*) ((char*)oc->jump_islands + islandSize * symbolNumber); + unsigned long *p = (unsigned long*) island; + + // lis r12, hi16(target) + *p++ = 0x3d800000 | ( ((unsigned long) target) >> 16 ); + // ori r12, r12, lo16(target) + *p++ = 0x618c0000 | ( ((unsigned long) target) & 0xFFFF ); + // mtctr r12 + *p++ = 0x7d8903a6; + // bctr + *p++ = 0x4e800420; + + return (void*) island; +} + +static char* relocateAddress( + ObjectCode* oc, + int nSections, + struct section* sections, + unsigned long address) +{ + int i; + for(i = 0; i < nSections; i++) + { + if(sections[i].addr <= address + && address < sections[i].addr + sections[i].size) + { + return oc->image + sections[i].offset + address - sections[i].addr; + } + } + barf("Invalid Mach-O file:" + "Address out of bounds while relocating object file"); + return NULL; +} + +static int relocateSection( + ObjectCode* oc, + char *image, + struct symtab_command *symLC, struct nlist *nlist, + int nSections, struct section* sections, struct section *sect) +{ + struct relocation_info *relocs; + int i,n; + + if(!strcmp(sect->sectname,"__la_symbol_ptr")) + return 1; + else if(!strcmp(sect->sectname,"__nl_symbol_ptr")) + return 1; + + n = sect->nreloc; + relocs = (struct relocation_info*) (image + sect->reloff); + + for(i=0;ir_pcrel) + { + if(scat->r_length == 2) + { + unsigned long word = 0; + unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address); + checkProddableBlock(oc,wordPtr); + + // Step 1: Figure out what the relocated value should be + if(scat->r_type == GENERIC_RELOC_VANILLA) + { + word = scat->r_value + sect->offset + ((long) image); + } + 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) + { + struct scattered_relocation_info *pair = + (struct scattered_relocation_info*) &relocs[i+1]; + + if(!pair->r_scattered || pair->r_type != PPC_RELOC_PAIR) + barf("Invalid Mach-O file: " + "PPC_RELOC_*_SECTDIFF not followed by PPC_RELOC_PAIR"); + + word = (unsigned long) + (relocateAddress(oc, nSections, sections, scat->r_value) + - relocateAddress(oc, nSections, sections, pair->r_value)); + i++; + } + else + continue; // ignore the others + + if(scat->r_type == GENERIC_RELOC_VANILLA + || scat->r_type == PPC_RELOC_SECTDIFF) + { + *wordPtr = word; + } + else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF) + { + ((unsigned short*) wordPtr)[1] = word & 0xFFFF; + } + else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF) + { + ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF; + } + else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF) + { + ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF) + + ((word & (1<<15)) ? 1 : 0); + } + } + } + + continue; // FIXME: I hope it's OK to ignore all the others. + } + else + { + struct relocation_info *reloc = &relocs[i]; + if(reloc->r_pcrel && !reloc->r_extern) + continue; + + if(reloc->r_length == 2) + { + unsigned long word = 0; + unsigned long jumpIsland = 0; + long offsetToJumpIsland; + + unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address); + checkProddableBlock(oc,wordPtr); + + if(reloc->r_type == GENERIC_RELOC_VANILLA) + { + word = *wordPtr; + } + 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; + } + + + 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; + word = (unsigned long) (lookupSymbol(nm)); + if(!word) + { + belch("\nunknown symbol `%s'", nm); + return 0; + } + + if(reloc->r_pcrel) + { + jumpIsland = (long) makeJumpIsland(oc,reloc->r_symbolnum,(void*)word); + word -= ((long)image) + sect->offset + reloc->r_address; + if(jumpIsland != 0) + { + offsetToJumpIsland = jumpIsland + - (((long)image) + sect->offset + reloc->r_address); + } + } + } + + if(reloc->r_type == GENERIC_RELOC_VANILLA) + { + *wordPtr = word; + continue; + } + 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) + { + // 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"); + + word = offsetToJumpIsland; + if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000) + barf("unconditional relative branch out of range: " + "jump island out of range"); + } + *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC); + continue; + } + } + barf("\nunknown relocation %d",reloc->r_type); + return 0; + } + } + return 1; +} + +static int ocGetNames_MachO(ObjectCode* oc) +{ + char *image = (char*) oc->image; + struct mach_header *header = (struct mach_header*) image; + struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header)); + unsigned i,curSymbol; + struct segment_command *segLC = NULL; + struct section *sections; + struct symtab_command *symLC = NULL; + struct dysymtab_command *dsymLC = NULL; + struct nlist *nlist; + unsigned long commonSize = 0; + char *commonStorage = NULL; + unsigned long commonCounter; + + for(i=0;incmds;i++) + { + if(lc->cmd == LC_SEGMENT) + 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 ); + } + + sections = (struct section*) (segLC+1); + nlist = (struct nlist*) (image + symLC->symoff); + + for(i=0;insects;i++) + { + if(sections[i].size == 0) + continue; + + if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL) + { + char * zeroFillArea = stgCallocBytes(1,sections[i].size, + "ocGetNames_MachO(common symbols)"); + 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), + sections[i].size); + } + + // count external symbols defined here + oc->n_symbols = 0; + for(i=dsymLC->iextdefsym;iiextdefsym+dsymLC->nextdefsym;i++) + { + if((nlist[i].n_type & N_TYPE) == N_SECT) + oc->n_symbols++; + } + 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)) + { + commonSize += nlist[i].n_value; + oc->n_symbols++; + } + } + oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*), + "ocGetNames_MachO(oc->symbols)"); + + // insert symbols into hash table + for(i=dsymLC->iextdefsym,curSymbol=0;iiextdefsym+dsymLC->nextdefsym;i++) + { + if((nlist[i].n_type & N_TYPE) == N_SECT) + { + char *nm = image + symLC->stroff + nlist[i].n_un.n_strx; + ghciInsertStrHashTable(oc->fileName, symhash, nm, image + + sections[nlist[i].n_sect-1].offset + - sections[nlist[i].n_sect-1].addr + + nlist[i].n_value); + oc->symbols[curSymbol++] = nm; + } + } + + // insert local symbols into lochash + for(i=dsymLC->ilocalsym;iilocalsym+dsymLC->nlocalsym;i++) + { + if((nlist[i].n_type & N_TYPE) == N_SECT) + { + char *nm = image + symLC->stroff + nlist[i].n_un.n_strx; + ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image + + sections[nlist[i].n_sect-1].offset + - sections[nlist[i].n_sect-1].addr + + nlist[i].n_value); + } + } + + + commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)"); + commonCounter = (unsigned long)commonStorage; + 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; + + ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter); + oc->symbols[curSymbol++] = nm; + + commonCounter += sz; + } + } + return 1; +} + +static int ocResolve_MachO(ObjectCode* oc) +{ + char *image = (char*) oc->image; + struct mach_header *header = (struct mach_header*) image; + struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header)); + unsigned i; + struct segment_command *segLC = NULL; + struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL; + struct symtab_command *symLC = NULL; + struct dysymtab_command *dsymLC = NULL; + struct nlist *nlist; + unsigned long *indirectSyms; + + for(i=0;incmds;i++) + { + if(lc->cmd == LC_SEGMENT) + 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 ); + } + + sections = (struct section*) (segLC+1); + nlist = (struct nlist*) (image + symLC->symoff); + + for(i=0;insects;i++) + { + if(!strcmp(sections[i].sectname,"__la_symbol_ptr")) + la_ptrs = §ions[i]; + else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr")) + nl_ptrs = §ions[i]; + } + + indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff); + + if(la_ptrs) + if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist)) + return 0; + if(nl_ptrs) + if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist)) + return 0; + + for(i=0;insects;i++) + { + if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i])) + return 0; + } + + /* Free the local symbol table; we won't need it again. */ + freeHashTable(oc->lochash, NULL); + oc->lochash = NULL; + + /* + Flush the data & instruction caches. + Because the PPC has split data/instruction caches, we have to + do that whenever we modify code at runtime. + */ + { + int n = (oc->fileSize + islandSize * oc->n_islands) / 4; + unsigned long *p = (unsigned long*)oc->image; + while(n--) + { + __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0" + : : "r" (p)); + p++; + } + __asm__ volatile ("sync\n\tisync"); + } + return 1; +} + +/* + * The Mach-O object format uses leading underscores. But not everywhere. + * There is a small number of runtime support functions defined in + * libcc_dynamic.a whose name does not have a leading underscore. + * As a consequence, we can't get their address from C code. + * We have to use inline assembler just to take the address of a function. + * Yuck. + */ + +static void machoInitSymbolsWithoutUnderscore() +{ + void *p; + +#undef Sym +#define Sym(x) \ + __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \ + ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p); + + RTS_MACHO_NOUNDERLINE_SYMBOLS + +} +#endif