/* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.61 2001/08/31 11:44:12 sewardj Exp $
+ * $Id: Linker.c,v 1.96 2002/06/15 19:38:11 wolfgang Exp $
*
* (c) The GHC Team, 2000, 2001
*
*
* ---------------------------------------------------------------------------*/
+#if 0
#include "PosixSource.h"
+#endif
#include "Rts.h"
#include "RtsFlags.h"
#include "HsFFI.h"
#include "LinkerInternals.h"
#include "RtsUtils.h"
#include "StoragePriv.h"
+#include "Schedule.h"
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#include <dlfcn.h>
#endif
+#if defined(cygwin32_TARGET_OS)
+#ifdef HAVE_DIRENT_H
+#include <dirent.h>
+#endif
+
+#ifdef HAVE_SYS_TIME_H
+#include <sys/time.h>
+#endif
+#include <regex.h>
+#include <sys/fcntl.h>
+#include <sys/termios.h>
+#include <sys/utime.h>
+#include <sys/utsname.h>
+#include <sys/wait.h>
+#endif
+
+#if defined(ia64_TARGET_ARCH)
+#define USE_MMAP
+#include <fcntl.h>
+#include <sys/mman.h>
+#endif
+
#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS)
# define OBJFORMAT_ELF
#elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
# define OBJFORMAT_PEi386
# include <windows.h>
+#elif defined(darwin_TARGET_OS)
+# define OBJFORMAT_MACHO
+# include <mach-o/loader.h>
+# include <mach-o/nlist.h>
+# include <mach-o/reloc.h>
#endif
/* Hash table mapping symbol names to Symbol */
static int ocVerifyImage_PEi386 ( ObjectCode* oc );
static int ocGetNames_PEi386 ( ObjectCode* oc );
static int ocResolve_PEi386 ( ObjectCode* oc );
+#elif defined(OBJFORMAT_MACHO)
+static int ocVerifyImage_MachO ( ObjectCode* oc );
+static int ocGetNames_MachO ( ObjectCode* oc );
+static int ocResolve_MachO ( ObjectCode* oc );
#endif
/* -----------------------------------------------------------------------------
#endif
#if !defined (mingw32_TARGET_OS)
-
#define RTS_POSIX_ONLY_SYMBOLS \
SymX(stg_sig_install) \
Sym(nocldstop)
-#define RTS_MINGW_ONLY_SYMBOLS /**/
+#endif
-#else
+#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) \
+ Sym(__divdi3) \
+ Sym(__udivdi3) \
+ Sym(__moddi3) \
+ Sym(__umoddi3)
-#define RTS_POSIX_ONLY_SYMBOLS
+#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 /**/
/* 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(memset) \
+ SymX(memset) \
SymX(inet_ntoa) \
SymX(inet_addr) \
SymX(htonl) \
Sym(mktime) \
Sym(_imp___timezone) \
Sym(_imp___tzname) \
+ Sym(_imp___iob) \
Sym(localtime) \
Sym(gmtime) \
- SymX(getenv) \
- SymX(free) \
- SymX(rename) \
Sym(opendir) \
Sym(readdir) \
+ Sym(rewinddir) \
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(__umoddi3)
#endif
+#ifndef SMP
+# define MAIN_CAP_SYM SymX(MainCapability)
+#else
+# define MAIN_CAP_SYM
+#endif
#define RTS_SYMBOLS \
- SymX(MainRegTable) \
- Sym(stg_gc_enter_1) \
- Sym(stg_gc_noregs) \
- Sym(stg_gc_seq_1) \
- Sym(stg_gc_d1) \
- Sym(stg_gc_f1) \
- Sym(stg_gc_ut_1_0) \
- Sym(stg_gc_ut_0_1) \
- Sym(stg_gc_unpt_r1) \
- Sym(stg_gc_unbx_r1) \
- Sym(stg_chk_0) \
- Sym(stg_chk_1) \
- Sym(stg_gen_chk) \
- SymX(stg_exit) \
- SymX(stg_update_PAP) \
+ Maybe_ForeignObj \
+ Maybe_Stable_Names \
+ Sym(StgReturn) \
+ Sym(__stginit_GHCziPrim) \
+ Sym(init_stack) \
+ SymX(__stg_chk_0) \
+ SymX(__stg_chk_1) \
+ SymX(stg_chk_2) \
+ SymX(stg_chk_3) \
+ SymX(stg_chk_4) \
+ SymX(stg_chk_5) \
+ SymX(stg_chk_6) \
+ SymX(stg_chk_7) \
+ SymX(stg_chk_8) \
+ Sym(stg_enterStackTop) \
+ SymX(stg_gc_d1) \
+ SymX(stg_gc_l1) \
+ SymX(__stg_gc_enter_1) \
+ SymX(stg_gc_enter_2) \
+ SymX(stg_gc_enter_3) \
+ SymX(stg_gc_enter_4) \
+ SymX(stg_gc_enter_5) \
+ SymX(stg_gc_enter_6) \
+ SymX(stg_gc_enter_7) \
+ SymX(stg_gc_enter_8) \
+ SymX(stg_gc_f1) \
+ SymX(stg_gc_noregs) \
+ SymX(stg_gc_seq_1) \
+ SymX(stg_gc_unbx_r1) \
+ SymX(stg_gc_unpt_r1) \
+ SymX(stg_gc_ut_0_1) \
+ SymX(stg_gc_ut_1_0) \
+ SymX(stg_gen_chk) \
+ SymX(stg_yield_to_interpreter) \
+ SymX(ErrorHdrHook) \
+ MAIN_CAP_SYM \
+ SymX(MallocFailHook) \
+ SymX(NoRunnableThreadsHook) \
+ SymX(OnExitHook) \
+ SymX(OutOfHeapHook) \
+ SymX(PatErrorHdrHook) \
+ SymX(PostTraceHook) \
+ SymX(PreTraceHook) \
+ SymX(StackOverflowHook) \
+ SymX(__encodeDouble) \
+ SymX(__encodeFloat) \
+ SymX(__gmpn_gcd_1) \
+ SymX(__gmpz_cmp) \
+ SymX(__gmpz_cmp_si) \
+ SymX(__gmpz_cmp_ui) \
+ SymX(__gmpz_get_si) \
+ SymX(__gmpz_get_ui) \
+ SymX(__int_encodeDouble) \
+ SymX(__int_encodeFloat) \
+ SymX(andIntegerzh_fast) \
+ SymX(blockAsyncExceptionszh_fast) \
+ 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(forkProcesszh_fast) \
+ SymX(freeHaskellFunctionPtr) \
+ SymX(freeStablePtr) \
+ SymX(gcdIntegerzh_fast) \
+ SymX(gcdIntegerIntzh_fast) \
+ SymX(gcdIntzh_fast) \
+ SymX(getProgArgv) \
+ SymX(getStablePtr) \
+ SymX(int2Integerzh_fast) \
+ SymX(integer2Intzh_fast) \
+ SymX(integer2Wordzh_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(newMVarzh_fast) \
+ SymX(newMutVarzh_fast) \
+ SymX(newPinnedByteArrayzh_fast) \
+ SymX(orIntegerzh_fast) \
+ SymX(performGC) \
+ SymX(plusIntegerzh_fast) \
+ SymX(prog_argc) \
+ SymX(prog_argv) \
+ SymX(putMVarzh_fast) \
+ SymX(quotIntegerzh_fast) \
+ SymX(quotRemIntegerzh_fast) \
+ SymX(raisezh_fast) \
+ SymX(remIntegerzh_fast) \
+ SymX(resetNonBlockingFd) \
+ SymX(resumeThread) \
+ SymX(rts_apply) \
+ SymX(rts_checkSchedStatus) \
+ SymX(rts_eval) \
+ SymX(rts_evalIO) \
+ SymX(rts_evalLazyIO) \
+ SymX(rts_eval_) \
+ SymX(rts_getAddr) \
+ SymX(rts_getBool) \
+ SymX(rts_getChar) \
+ SymX(rts_getDouble) \
+ SymX(rts_getFloat) \
+ SymX(rts_getInt) \
+ SymX(rts_getInt32) \
+ SymX(rts_getPtr) \
+ SymX(rts_getStablePtr) \
+ SymX(rts_getThreadId) \
+ SymX(rts_getWord) \
+ SymX(rts_getWord32) \
+ SymX(rts_mkAddr) \
+ SymX(rts_mkBool) \
+ SymX(rts_mkChar) \
+ SymX(rts_mkDouble) \
+ SymX(rts_mkFloat) \
+ SymX(rts_mkInt) \
+ SymX(rts_mkInt16) \
+ SymX(rts_mkInt32) \
+ SymX(rts_mkInt64) \
+ SymX(rts_mkInt8) \
+ SymX(rts_mkPtr) \
+ SymX(rts_mkStablePtr) \
+ SymX(rts_mkString) \
+ SymX(rts_mkWord) \
+ SymX(rts_mkWord16) \
+ SymX(rts_mkWord32) \
+ SymX(rts_mkWord64) \
+ SymX(rts_mkWord8) \
+ SymX(run_queue_hd) \
+ SymX(setProgArgv) \
+ SymX(shutdownHaskellAndExit) \
+ SymX(stable_ptr_table) \
+ SymX(stackOverflow) \
+ SymX(stg_CAF_BLACKHOLE_info) \
+ 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_1_upd_info) \
SymX(stg_ap_2_upd_info) \
SymX(stg_ap_3_upd_info) \
SymX(stg_ap_6_upd_info) \
SymX(stg_ap_7_upd_info) \
SymX(stg_ap_8_upd_info) \
+ SymX(stg_exit) \
SymX(stg_sel_0_upd_info) \
+ SymX(stg_sel_10_upd_info) \
+ SymX(stg_sel_11_upd_info) \
+ SymX(stg_sel_12_upd_info) \
+ SymX(stg_sel_13_upd_info) \
+ SymX(stg_sel_14_upd_info) \
+ SymX(stg_sel_15_upd_info) \
SymX(stg_sel_1_upd_info) \
SymX(stg_sel_2_upd_info) \
SymX(stg_sel_3_upd_info) \
SymX(stg_sel_7_upd_info) \
SymX(stg_sel_8_upd_info) \
SymX(stg_sel_9_upd_info) \
- SymX(stg_sel_10_upd_info) \
- SymX(stg_sel_11_upd_info) \
- SymX(stg_sel_12_upd_info) \
- SymX(stg_sel_13_upd_info) \
- SymX(stg_sel_14_upd_info) \
- SymX(stg_sel_15_upd_info) \
- SymX(stg_upd_frame_info) \
SymX(stg_seq_frame_info) \
- SymX(stg_CAF_BLACKHOLE_info) \
- SymX(stg_IND_STATIC_info) \
- SymX(stg_EMPTY_MVAR_info) \
- SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
- SymX(stg_WEAK_info) \
- SymX(stg_CHARLIKE_closure) \
- SymX(stg_INTLIKE_closure) \
- SymX(newCAF) \
- SymX(newBCOzh_fast) \
- SymX(mkApUpd0zh_fast) \
- SymX(putMVarzh_fast) \
- SymX(newMVarzh_fast) \
+ SymX(stg_upd_frame_info) \
+ SymX(__stg_update_PAP) \
+ SymX(suspendThread) \
SymX(takeMVarzh_fast) \
- SymX(tryTakeMVarzh_fast) \
+ SymX(timesIntegerzh_fast) \
SymX(tryPutMVarzh_fast) \
- SymX(catchzh_fast) \
- SymX(raisezh_fast) \
- SymX(forkzh_fast) \
- SymX(delayzh_fast) \
- SymX(yieldzh_fast) \
- SymX(killThreadzh_fast) \
+ SymX(tryTakeMVarzh_fast) \
+ SymX(unblockAsyncExceptionszh_fast) \
+ SymX(unsafeThawArrayzh_fast) \
SymX(waitReadzh_fast) \
SymX(waitWritezh_fast) \
- SymX(suspendThread) \
- SymX(resumeThread) \
- SymX(stackOverflow) \
- SymX(int2Integerzh_fast) \
SymX(word2Integerzh_fast) \
- Maybe_ForeignObj \
- SymX(__encodeDouble) \
- SymX(decodeDoublezh_fast) \
- SymX(decodeFloatzh_fast) \
- SymX(gcdIntegerzh_fast) \
- SymX(newArrayzh_fast) \
- SymX(unsafeThawArrayzh_fast) \
- SymX(newByteArrayzh_fast) \
- SymX(newPinnedByteArrayzh_fast) \
- SymX(newMutVarzh_fast) \
- SymX(quotRemIntegerzh_fast) \
- SymX(quotIntegerzh_fast) \
- SymX(remIntegerzh_fast) \
- SymX(divExactIntegerzh_fast) \
- SymX(divModIntegerzh_fast) \
- SymX(timesIntegerzh_fast) \
- SymX(minusIntegerzh_fast) \
- SymX(plusIntegerzh_fast) \
- SymX(andIntegerzh_fast) \
- SymX(orIntegerzh_fast) \
SymX(xorIntegerzh_fast) \
- SymX(complementIntegerzh_fast) \
- Maybe_Stable_Names \
- SymX(blockAsyncExceptionszh_fast) \
- SymX(unblockAsyncExceptionszh_fast) \
- SymX(isDoubleNaN) \
- SymX(isDoubleInfinite) \
- SymX(isDoubleDenormalized) \
- SymX(isDoubleNegativeZero) \
- SymX(__encodeFloat) \
- SymX(isFloatNaN) \
- SymX(isFloatInfinite) \
- SymX(isFloatDenormalized) \
- SymX(isFloatNegativeZero) \
- SymX(__int_encodeFloat) \
- SymX(__int_encodeDouble) \
- SymX(__gmpz_cmp_si) \
- SymX(__gmpz_cmp_ui) \
- SymX(__gmpz_cmp) \
- SymX(__gmpn_gcd_1) \
- SymX(__gmpz_get_si) \
- SymX(__gmpz_get_ui) \
- SymX(prog_argv) \
- SymX(prog_argc) \
- SymX(getProgArgv) \
- SymX(setProgArgv) \
- SymX(resetNonBlockingFd) \
- SymX(performGC) \
- SymX(getStablePtr) \
- SymX(stable_ptr_table) \
- SymX(shutdownHaskellAndExit) \
- Sym(stg_enterStackTop) \
- Sym(stg_yield_to_interpreter) \
- Sym(StgReturn) \
- Sym(init_stack) \
- SymX(cmp_thread) \
- Sym(__init_PrelGHC) \
- SymX(freeHaskellFunctionPtr) \
- SymX(OnExitHook) \
- SymX(ErrorHdrHook) \
- SymX(NoRunnableThreadsHook) \
- SymX(StackOverflowHook) \
- SymX(OutOfHeapHook) \
- SymX(MallocFailHook) \
- SymX(PatErrorHdrHook) \
- SymX(defaultsHook) \
- SymX(PreTraceHook) \
- SymX(PostTraceHook) \
- SymX(createAdjustor) \
- SymX(rts_mkChar) \
- SymX(rts_mkInt) \
- SymX(rts_mkInt8) \
- SymX(rts_mkInt16) \
- SymX(rts_mkInt32) \
- SymX(rts_mkInt64) \
- SymX(rts_mkWord) \
- SymX(rts_mkWord8) \
- SymX(rts_mkWord16) \
- SymX(rts_mkWord32) \
- SymX(rts_mkWord64) \
- SymX(rts_mkPtr) \
- SymX(rts_mkFloat) \
- SymX(rts_mkDouble) \
- SymX(rts_mkStablePtr) \
- SymX(rts_mkBool) \
- SymX(rts_mkString) \
- SymX(rts_apply) \
- SymX(rts_mkAddr) \
- SymX(rts_getChar) \
- SymX(rts_getInt) \
- SymX(rts_getInt32) \
- SymX(rts_getWord) \
- SymX(rts_getWord32) \
- SymX(rts_getPtr) \
- SymX(rts_getFloat) \
- SymX(rts_getDouble) \
- SymX(rts_getStablePtr) \
- SymX(rts_getBool) \
- SymX(rts_getAddr) \
- SymX(rts_eval) \
- SymX(rts_eval_) \
- SymX(rts_evalIO) \
- SymX(rts_evalLazyIO) \
- SymX(rts_checkSchedStatus)
+ 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 ia64_TARGET_ARCH
+/* force these symbols to be present */
+#define RTS_EXTRA_SYMBOLS \
+ Sym(__divsf3)
+#elif defined(powerpc_TARGET_ARCH)
+#define RTS_EXTRA_SYMBOLS \
+ Sym(__divdi3) \
+ Sym(__udivdi3) \
+ Sym(__moddi3) \
+ Sym(__umoddi3) \
+ Sym(__ashldi3) \
+ Sym(__ashrdi3) \
+ Sym(__lshrdi3)
+#else
+#define RTS_EXTRA_SYMBOLS /* nothing */
+#endif
/* entirely bogus claims about types of these symbols */
#define Sym(vvv) extern void (vvv);
#define SymX(vvv) /**/
RTS_SYMBOLS
RTS_LONG_LONG_SYMS
+RTS_EXTRA_SYMBOLS
RTS_POSIX_ONLY_SYMBOLS
RTS_MINGW_ONLY_SYMBOLS
+RTS_CYGWIN_ONLY_SYMBOLS
#undef Sym
#undef SymX
static RtsSymbolVal rtsSyms[] = {
RTS_SYMBOLS
RTS_LONG_LONG_SYMS
+ RTS_EXTRA_SYMBOLS
RTS_POSIX_ONLY_SYMBOLS
RTS_MINGW_ONLY_SYMBOLS
+ RTS_CYGWIN_ONLY_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)
+#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
static void *dl_prog_handle;
#endif
/* 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_ELF) || defined(OBJFORMAT_MACHO)
dl_prog_handle = dlopen(NULL, RTLD_LAZY);
# endif
}
* 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.
*/
char* name;
struct _OpenedDLL* next;
HINSTANCE instance;
- }
+ }
OpenedDLL;
/* A list thereof. */
-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)
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);
+ hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
if (hdl == NULL) {
/* dlopen failed; return a ptr to the error msg. */
errmsg = dlerror();
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) {
+ free(buf);
+
+ /* LoadLibrary failed; return a ptr to the error msg. */
+ return "addDLL: unknown error";
+ }
}
+ free(buf);
o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
/* -----------------------------------------------------------------------------
* lookup a symbol in the hash table
- */
+ */
void *
lookupSymbol( char *lbl )
{
val = lookupStrHashTable(symhash, lbl);
if (val == NULL) {
-# if defined(OBJFORMAT_ELF)
+# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
return dlsym(dl_prog_handle, lbl);
# 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); */
- 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
- a Rule that governs whether an initial '_' *should always* be
- stripped off when mapping from import lib name to the DLL name.
- */
- sym = GetProcAddress(o_dll->instance, (lbl+1));
- if (sym != NULL) return sym;
- }
+ /* 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
+ a Rule that governs whether an initial '_' *should always* be
+ stripped off when mapping from import lib name to the DLL name.
+ */
+ sym = GetProcAddress(o_dll->instance, (lbl+1));
+ 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
}
}
-static
+static
+__attribute((unused))
void *
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;
+ 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.
ObjectCode* oc;
struct stat st;
int r, n;
+#ifdef USE_MMAP
+ int fd, pagesize;
+ void *map_addr;
+#else
FILE *f;
+#endif
/* 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)");
oc->formatName = "ELF";
# elif defined(OBJFORMAT_PEi386)
oc->formatName = "PEi386";
+# elif defined(OBJFORMAT_MACHO)
+ oc->formatName = "Mach-O";
# else
free(oc);
barf("loadObj: not implemented on this platform");
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();
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 */
/* 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
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
*
* Returns: 1 if ok, 0 on error.
*/
-HsInt
+HsInt
resolveObjs( void )
{
ObjectCode *oc;
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
/* 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) {
*/
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);
barf("checkProddableBlock: invalid fixup in runtime linker");
}
+/* -----------------------------------------------------------------------------
+ * Section management.
+ */
+static void addSection ( ObjectCode* oc, SectionKind kind,
+ void* start, void* end )
+{
+ Section* s = stgMallocBytes(sizeof(Section), "addSection");
+ s->start = start;
+ s->end = end;
+ 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 );
+ */
+}
+
+
/* --------------------------------------------------------------------------
* 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)
typedef int Int32;
-typedef
+typedef
struct {
UInt16 Machine;
UInt16 NumberOfSections;
#define sizeof_COFF_header 20
-typedef
+typedef
struct {
UChar Name[8];
UInt32 VirtualSize;
UInt32 PointerToLinenumbers;
UInt16 NumberOfRelocations;
UInt16 NumberOfLineNumbers;
- UInt32 Characteristics;
+ UInt32 Characteristics;
}
COFF_section;
/* 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
/* 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
{
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);
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;
}
# 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;
static int
ocVerifyImage_PEi386 ( ObjectCode* oc )
{
- int i, j;
+ int i;
+ UInt32 j, noRelocs;
COFF_header* hdr;
COFF_section* sectab;
COFF_symbol* symtab;
/* 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;
}
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;
}
+ /* If the string table size is way crazy, this might indicate that
+ 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 > 510000) {
+#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) );
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"
((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" );
}
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");
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"
(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++;
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
/* 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);
- /* fprintf(stderr, "BSS section at 0x%x\n", zspace); */
+ /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
+ }
+
+ /* Copy section information into the ObjectCode. */
+
+ for (i = 0; i < hdr->NumberOfSections; i++) {
+ UChar* start;
+ UChar* end;
+ UInt32 sz;
+
+ SectionKind kind
+ = SECTIONKIND_OTHER;
+ COFF_section* sectab_i
+ = (COFF_section*)
+ myindex ( sizeof_COFF_section, sectab, i );
+ 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
+ alternative of testing the sectab_i->Name field seems to
+ work ok with Cygwin.
+ */
+ if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
+ sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
+ kind = SECTIONKIND_CODE_OR_RODATA;
+# endif
+
+ if (0==strcmp(".text",sectab_i->Name) ||
+ 0==strcmp(".rodata",sectab_i->Name))
+ kind = SECTIONKIND_CODE_OR_RODATA;
+ if (0==strcmp(".data",sectab_i->Name) ||
+ 0==strcmp(".bss",sectab_i->Name))
+ kind = SECTIONKIND_RWDATA;
+
+ ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
+ sz = sectab_i->SizeOfRawData;
+ if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
+
+ start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
+ end = start + sz - 1;
+
+ 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 (kind != SECTIONKIND_OTHER && end >= start) {
+ addSection(oc, kind, start, end);
+ addProddableBlock(oc, start, end - start + 1);
+ }
}
/* Copy exported symbols into the ObjectCode. */
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;
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,
+ ((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"
(Int32)(symtab_i->SectionNumber),
(UInt32)symtab_i->Type,
(UInt32)symtab_i->StorageClass,
- (UInt32)symtab_i->NumberOfAuxSymbols
+ (UInt32)symtab_i->NumberOfAuxSymbols
);
# endif
}
i++;
}
- /* Copy section information into the ObjectCode. */
-
- oc->n_sections = hdr->NumberOfSections;
- oc->sections = stgMallocBytes( oc->n_sections * sizeof(Section),
- "ocGetNamesPEi386" );
-
- for (i = 0; i < oc->n_sections; i++) {
- UChar* start;
- UChar* end;
-
- SectionKind kind
- = SECTIONKIND_OTHER;
- COFF_section* sectab_i
- = (COFF_section*)
- myindex ( sizeof_COFF_section, sectab, i );
- 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
- alternative of testing the sectab_i->Name field seems to
- work ok with Cygwin.
- */
- if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
- sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
- kind = SECTIONKIND_CODE_OR_RODATA;
-# endif
-
- if (0==strcmp(".text",sectab_i->Name) ||
- 0==strcmp(".rodata",sectab_i->Name))
- kind = SECTIONKIND_CODE_OR_RODATA;
- if (0==strcmp(".data",sectab_i->Name) ||
- 0==strcmp(".bss",sectab_i->Name))
- kind = SECTIONKIND_RWDATA;
-
- start = ((UChar*)(oc->image))
- + sectab_i->PointerToRawData;
- end = start
- + sectab_i->SizeOfRawData - 1;
-
- if (kind == SECTIONKIND_OTHER) {
- belch("Unknown PEi386 section name `%s'", sectab_i->Name);
- return 0;
- }
-
- if (end >= start) {
- oc->sections[i].start = start;
- oc->sections[i].end = end;
- oc->sections[i].kind = kind;
- addProddableBlock(oc, start, end - start + 1);
- }
- }
-
- return 1;
+ return 1;
}
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. */
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
= (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).
+ */
+ COFF_reloc* rel = (COFF_reloc*)
+ myindex ( sizeof_COFF_reloc, reltab, 0 );
+ noRelocs = rel->VirtualAddress;
+ fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
+ 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 )
);
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);
+ sym->Value);
} else {
copyName ( sym->Name, strtab, symbol, 1000-1 );
+ (void*)S = lookupLocalSymbol( oc, symbol );
+ if ((void*)S != NULL) goto foundit;
+ (void*)S = lookupSymbol( symbol );
+ if ((void*)S != NULL) goto foundit;
zapTrailingAtSign ( symbol );
(void*)S = lookupLocalSymbol( oc, symbol );
- if ((void*)S == NULL)
- (void*)S = lookupSymbol( symbol );
- if (S == 0) {
- belch("%s: unknown symbol `%s'", oc->fileName, symbol);
- return 0;
- }
+ if ((void*)S != NULL) goto foundit;
+ (void*)S = lookupSymbol( symbol );
+ if ((void*)S != NULL) goto foundit;
+ belch("%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
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;
}
# define ELF_TARGET_SPARC /* Used inside <elf.h> */
#elif defined(i386_TARGET_ARCH)
# define ELF_TARGET_386 /* Used inside <elf.h> */
+#elif defined (ia64_TARGET_ARCH)
+# define ELF_TARGET_IA64 /* Used inside <elf.h> */
+# 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.
- */
#include <elf.h>
+/*
+ * 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
+#define ELF_ST_TYPE ELF32_ST_TYPE
+#define ELF_ST_BIND ELF32_ST_BIND
+#define ELF_R_TYPE ELF32_R_TYPE
+#define ELF_R_SYM ELF32_R_SYM
+#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;
}
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
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;
}
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) {
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;
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;
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);
}
k = 0;
- oc->n_sections = ehdr->e_shnum;
- oc->sections = stgMallocBytes( oc->n_sections * sizeof(Section),
- "ocGetNames_ELF(oc->sections)" );
-
- for (i = 0; i < oc->n_sections; i++) {
-
- /* 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) {
+ 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;
+ }
+
+ 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,
- "ocGetNames_ELF(anonymous bss)");
+ char* zspace = stgCallocBytes(1, shdr[i].sh_size,
+ "ocGetNames_ELF(BSS)");
shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
- /* We don't prod BSS sections, hence the following isn't
- necessary:
- addProddableBlock(oc, zspace, shdr[i].sh_size);
- */
- /*
- 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 */
- oc->sections[i].start = ehdrC + shdr[i].sh_offset;
- oc->sections[i].end = ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1;
- oc->sections[i].kind = kind;
- 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++) {
- if ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL
- || ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL
+
+ char isLocal = FALSE; /* avoids uninit-var warning */
+ char* ad = NULL;
+ char* nm = strtab + stab[j].st_name;
+ int secno = stab[j].st_shndx;
+
+ /* Figure out if we want to add it; if so, set ad to its
+ address. Otherwise leave ad == NULL. */
+
+ if (secno == SHN_COMMON) {
+ isLocal = FALSE;
+ ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
+ /*
+ 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 ( ( 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
&& 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
)
) {
- char* nm;
- char* ad;
- int secno = stab[j].st_shndx;
/* Section 0 is the undefined section, hence > and not >=. */
ASSERT(secno > 0 && secno < ehdr->e_shnum);
- nm = strtab + stab[j].st_name;
- /*
+ /*
if (shdr[secno].sh_type == SHT_NOBITS) {
- fprintf(stderr, "bss symbol, size %d off %d name %s\n",
- stab[j].st_size, stab[j].st_value, nm);
+ 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;
- ASSERT(nm != NULL);
- ASSERT(ad != NULL);
- oc->symbols[j] = nm;
- if (ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL) {
- IF_DEBUG(linker,belch( "addOTabName(LOCL): %10p %s %s",
- ad, oc->fileName, nm ));
- insertStrHashTable(oc->lochash, nm, ad);
+ 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 ));
- insertStrHashTable(symhash, nm, ad);
+ isLocal = FALSE;
}
}
- else {
- IF_DEBUG(linker,belch( "skipping `%s'",
+
+ /* And the decision is ... */
+
+ if (ad != NULL) {
+ ASSERT(nm != NULL);
+ oc->symbols[j] = nm;
+ /* Acquire! */
+ if (isLocal) {
+ /* Ignore entirely. */
+ } else {
+ ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
+ }
+ } else {
+ /* Skip. */
+ 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
);
*/
oc->symbols[j] = NULL;
}
+
}
}
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;
}
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)
+ for (j = 0; j < nent; j++) {
+#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)
+ assert(A == 0);
+#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, pP );
- 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_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_LTOFF_FPTR22:
+ addr = allocateGOTEntry(value);
+ ia64_reloc_gprel22(P, addr);
+ break;
+ case R_IA64_PCREL21B:
+ ia64_reloc_pcrel21(P, S, oc);
+ 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;
}
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;
}
}
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)
+
+/*
+ Initial 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:
+ *) get common symbols and .bss sections to work properly.
+ Haskell modules seem to work, but C modules can cause problems
+ *) implement ocVerifyImage_MachO
+ *) add more sanity checks. The current code just has to segfault if there's a
+ broken .o file.
+*/
+
+static int ocVerifyImage_MachO(ObjectCode* oc)
+{
+ // FIXME: do some verifying here
+ return 1;
+}
+
+static void resolveImports(
+ 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*4<sect->size;i++)
+ {
+ // according to otool, reserved1 contains the first index into the indirect symbol table
+ struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
+ char *nm = image + symLC->stroff + symbol->n_un.n_strx;
+ void *addr = NULL;
+
+ if((symbol->n_type & N_TYPE) == N_UNDF
+ && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
+ addr = (void*) (symbol->n_value);
+ else
+ addr = lookupSymbol(nm);
+ if(!addr)
+ {
+ fprintf(stderr, "not found: %s\n", nm);
+ abort();
+ }
+ ASSERT(addr);
+ ((void**)(image + sect->offset))[i] = addr;
+ }
+}
+
+static void relocateSection(char *image,
+ struct symtab_command *symLC, struct nlist *nlist,
+ struct section* sections, struct section *sect)
+{
+ struct relocation_info *relocs;
+ int i,n;
+
+ if(!strcmp(sect->sectname,"__la_symbol_ptr"))
+ return;
+ else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
+ return;
+
+ n = sect->nreloc;
+ relocs = (struct relocation_info*) (image + sect->reloff);
+
+ for(i=0;i<n;i++)
+ {
+ if(relocs[i].r_address & R_SCATTERED)
+ {
+ struct scattered_relocation_info *scat =
+ (struct scattered_relocation_info*) &relocs[i];
+
+ if(!scat->r_pcrel)
+ {
+ if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
+ {
+ unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
+
+ *word = scat->r_value + sect->offset + ((long) image);
+ }
+ }
+
+ 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_pcrel
+ && reloc->r_length == 2
+ && reloc->r_type == GENERIC_RELOC_VANILLA)
+ {
+ unsigned long* word = (unsigned long*) (image + sect->offset + reloc->r_address);
+
+ 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 = lookupSymbol(nm);
+ ASSERT(*word);
+ }
+ continue;
+ }
+ fprintf(stderr, "unknown reloc\n");
+ abort();
+ ASSERT(2 + 2 == 5);
+ }
+ }
+}
+
+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));
+ int i,curSymbol;
+ 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 commonSize = 0;
+ char *commonStorage = NULL;
+ unsigned long commonCounter;
+
+ for(i=0;i<header->ncmds;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;i<segLC->nsects;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];
+
+ // for now, only add __text and __const to the sections table
+ else 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));
+ }
+
+ // count external symbols defined here
+ oc->n_symbols = 0;
+ for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
+ {
+ if((nlist[i].n_type & N_TYPE) == N_SECT)
+ oc->n_symbols++;
+ }
+ for(i=0;i<symLC->nsyms;i++)
+ {
+ if((nlist[i].n_type & N_TYPE) == N_UNDF
+ && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
+ {
+ 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;i<dsymLC->iextdefsym+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;
+ }
+ }
+
+ commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
+ commonCounter = (unsigned long)commonStorage;
+ for(i=0;i<symLC->nsyms;i++)
+ {
+ if((nlist[i].n_type & N_TYPE) == N_UNDF
+ && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
+ {
+ char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
+ unsigned long sz = nlist[i].n_value;
+
+ nlist[i].n_value = commonCounter;
+
+ ghciInsertStrHashTable(oc->fileName, symhash, nm, nlist[i].n_value);
+ 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));
+ int 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;i<header->ncmds;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;i<segLC->nsects;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)
+ resolveImports(image,symLC,la_ptrs,indirectSyms,nlist);
+ if(nl_ptrs)
+ resolveImports(image,symLC,nl_ptrs,indirectSyms,nlist);
+
+ for(i=0;i<segLC->nsects;i++)
+ {
+ relocateSection(image,symLC,nlist,sections,§ions[i]);
+ }
+
+ /* Free the local symbol table; we won't need it again. */
+ freeHashTable(oc->lochash, NULL);
+ oc->lochash = NULL;
+ return 1;
+}
+
+#endif