/* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.12 2001/01/24 15:39:50 simonmar Exp $
+ * $Id: Linker.c,v 1.72 2001/10/26 11:33:13 sewardj Exp $
*
- * (c) The GHC Team, 2000
+ * (c) The GHC Team, 2000, 2001
*
* RTS Object Linker
*
* ---------------------------------------------------------------------------*/
+#include "PosixSource.h"
#include "Rts.h"
#include "RtsFlags.h"
#include "HsFFI.h"
#include "Hash.h"
#include "Linker.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
-#ifdef GHCI /* endif is right at end of file */
-
-/* A bucket in the symbol hash-table. Primarily, maps symbol names to
- * absolute addresses. All symbols from a given module are linked
- * together, so they can be freed at the same time. There's also a
- * bucket link field for the hash table.
- */
-typedef struct _SymbolVal {
- char *lbl;
- void *addr;
-} SymbolVal;
-
-typedef enum { OBJECT_LOADED, OBJECT_RESOLVED } OStatus;
-
-/* Indication of section kinds for loaded objects. Needed by
- the GC for deciding whether or not a pointer on the stack
- is a code pointer.
-*/
-typedef enum { SECTIONKIND_CODE_OR_RODATA,
- SECTIONKIND_RWDATA,
- SECTIONKIND_OTHER,
- SECTIONKIND_NOINFOAVAIL }
- SectionKind;
-
-typedef struct { void* start; void* end; SectionKind kind; }
- Section;
-
-/* Top-level structure for an object module. One of these is allocated
- * for each object file in use.
- */
-typedef struct _ObjectCode {
- OStatus status;
- char* fileName;
- int fileSize;
- char* formatName; /* eg "ELF32", "DLL", "COFF", etc. */
-
- SymbolVal *symbols;
- int n_symbols;
-
- /* ptr to malloc'd lump of memory holding the obj file */
- void* image;
-
- /* The section-kind entries for this object module. Dynamically expands. */
- Section* sections;
- int n_sections;
-
- /* Allow a chain of these things */
- struct _ObjectCode * next;
-} ObjectCode;
-
+#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>
+#endif
/* Hash table mapping symbol names to Symbol */
/*Str*/HashTable *symhash;
-/* List of currently loaded objects */
-ObjectCode *objects;
-
-#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
+#if defined(OBJFORMAT_ELF)
static int ocVerifyImage_ELF ( ObjectCode* oc );
static int ocGetNames_ELF ( ObjectCode* oc );
static int ocResolve_ELF ( ObjectCode* oc );
-#elif defined(cygwin32_TARGET_OS)
+#elif defined(OBJFORMAT_PEi386)
static int ocVerifyImage_PEi386 ( ObjectCode* oc );
static int ocGetNames_PEi386 ( ObjectCode* oc );
static int ocResolve_PEi386 ( ObjectCode* oc );
* Built-in symbols from the RTS
*/
+typedef struct _RtsSymbolVal {
+ char *lbl;
+ void *addr;
+} RtsSymbolVal;
+
+
+#if !defined(PAR)
+#define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
+
+#define Maybe_Stable_Names SymX(mkWeakzh_fast) \
+ SymX(makeStableNamezh_fast) \
+ SymX(finalizzeWeakzh_fast)
+#else
+/* These are not available in GUM!!! -- HWL */
+#define Maybe_ForeignObj
+#define Maybe_Stable_Names
+#endif
+
+#if !defined (mingw32_TARGET_OS)
+
+#define RTS_POSIX_ONLY_SYMBOLS \
+ SymX(stg_sig_install) \
+ Sym(nocldstop)
+#define RTS_MINGW_ONLY_SYMBOLS /**/
+
+#else
+
+#define RTS_POSIX_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(inet_ntoa) \
+ SymX(inet_addr) \
+ SymX(htonl) \
+ SymX(recvfrom) \
+ SymX(listen) \
+ SymX(bind) \
+ SymX(shutdown) \
+ SymX(connect) \
+ SymX(htons) \
+ SymX(ntohs) \
+ SymX(getservbyname) \
+ SymX(getservbyport) \
+ SymX(getprotobynumber) \
+ SymX(getprotobyname) \
+ SymX(gethostbyname) \
+ SymX(gethostbyaddr) \
+ SymX(gethostname) \
+ SymX(strcpy) \
+ SymX(strncpy) \
+ SymX(abort) \
+ Sym(_alloca) \
+ Sym(isxdigit) \
+ Sym(isupper) \
+ Sym(ispunct) \
+ Sym(islower) \
+ Sym(isspace) \
+ Sym(isprint) \
+ Sym(isdigit) \
+ Sym(iscntrl) \
+ Sym(isalpha) \
+ Sym(isalnum) \
+ SymX(strcmp) \
+ SymX(memmove) \
+ SymX(realloc) \
+ SymX(malloc) \
+ 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(memcpy) \
+ Sym(mktime) \
+ Sym(_imp___timezone) \
+ Sym(_imp___tzname) \
+ Sym(_imp___iob) \
+ Sym(localtime) \
+ Sym(gmtime) \
+ Sym(opendir) \
+ Sym(readdir) \
+ Sym(closedir) \
+ Sym(__divdi3) \
+ Sym(__udivdi3) \
+ Sym(__moddi3) \
+ Sym(__umoddi3)
+#endif
+
+
#define RTS_SYMBOLS \
- SymX(MainRegTable) \
+ 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_d1) \
- Sym(stg_gc_f1) \
- Sym(stg_gc_ut_1_0) \
- Sym(stg_gc_ut_0_1) \
Sym(stg_gc_unbx_r1) \
- Sym(stg_chk_0) \
- Sym(stg_chk_1) \
+ Sym(stg_gc_unpt_r1) \
+ Sym(stg_gc_ut_0_1) \
+ Sym(stg_gc_ut_1_0) \
Sym(stg_gen_chk) \
- SymX(stg_exit) \
- SymX(stg_update_PAP) \
+ Sym(stg_yield_to_interpreter) \
+ SymX(ErrorHdrHook) \
+ SymX(MainRegTable) \
+ 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(createAdjustor) \
+ SymX(decodeDoublezh_fast) \
+ SymX(decodeFloatzh_fast) \
+ SymX(defaultsHook) \
+ SymX(delayzh_fast) \
+ SymX(divExactIntegerzh_fast) \
+ SymX(divModIntegerzh_fast) \
+ SymX(forkzh_fast) \
+ SymX(freeHaskellFunctionPtr) \
+ SymX(gcdIntegerzh_fast) \
+ SymX(getProgArgv) \
+ SymX(getStablePtr) \
+ SymX(int2Integerzh_fast) \
+ SymX(isDoubleDenormalized) \
+ SymX(isDoubleInfinite) \
+ SymX(isDoubleNaN) \
+ SymX(isDoubleNegativeZero) \
+ SymX(isFloatDenormalized) \
+ SymX(isFloatInfinite) \
+ SymX(isFloatNaN) \
+ SymX(isFloatNegativeZero) \
+ SymX(killThreadzh_fast) \
+ SymX(minusIntegerzh_fast) \
+ SymX(mkApUpd0zh_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_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_4_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_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(stg_CAF_UNENTERED_entry) \
- 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(timesIntegerzh_fast) \
+ SymX(tryPutMVarzh_fast) \
SymX(tryTakeMVarzh_fast) \
- SymX(catchzh_fast) \
- SymX(raisezh_fast) \
- SymX(forkzh_fast) \
- SymX(delayzh_fast) \
- SymX(yieldzh_fast) \
- SymX(killThreadzh_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) \
- SymX(mkForeignObjzh_fast) \
- SymX(__encodeDouble) \
- SymX(decodeDoublezh_fast) \
- SymX(decodeFloatzh_fast) \
- SymX(gcdIntegerzh_fast) \
- SymX(newArrayzh_fast) \
- SymX(unsafeThawArrayzh_fast) \
- SymX(newByteArrayzh_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) \
- SymX(mkWeakzh_fast) \
- SymX(makeStableNamezh_fast) \
- SymX(finalizzeWeakzh_fast) \
- 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) \
- SymX(__gmpn_gcd_1) \
- SymX(prog_argv) \
- SymX(prog_argc) \
- SymX(resetNonBlockingFd) \
- 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(yieldzh_fast)
#ifndef SUPPORT_LONG_LONGS
#define RTS_LONG_LONG_SYMS /* nothing */
#else
-#define RTS_LONG_LONG_SYMS \
- SymX(stg_gtWord64) \
- SymX(stg_geWord64) \
- SymX(stg_eqWord64) \
- SymX(stg_neWord64) \
- SymX(stg_ltWord64) \
- SymX(stg_leWord64) \
- SymX(stg_gtInt64) \
- SymX(stg_geInt64) \
- SymX(stg_eqInt64) \
- SymX(stg_neInt64) \
- SymX(stg_ltInt64) \
- SymX(stg_leInt64) \
- SymX(stg_remWord64) \
- SymX(stg_quotWord64) \
- SymX(stg_remInt64) \
- SymX(stg_quotInt64) \
- SymX(stg_negateInt64) \
- SymX(stg_plusInt64) \
- SymX(stg_minusInt64) \
- SymX(stg_timesInt64) \
- SymX(stg_and64) \
- SymX(stg_or64) \
- SymX(stg_xor64) \
- SymX(stg_not64) \
- SymX(stg_shiftL64) \
- SymX(stg_shiftRL64) \
- SymX(stg_iShiftL64) \
- SymX(stg_iShiftRL64) \
- SymX(stg_iShiftRA64) \
- SymX(stg_intToInt64) \
- SymX(stg_int64ToInt) \
- SymX(stg_int64ToWord64) \
- SymX(stg_wordToWord64) \
- SymX(stg_word64ToWord) \
- SymX(stg_word64ToInt64) \
+#define RTS_LONG_LONG_SYMS \
SymX(int64ToIntegerzh_fast) \
SymX(word64ToIntegerzh_fast)
#endif /* SUPPORT_LONG_LONGS */
#define Sym(vvv) extern void (vvv);
#define SymX(vvv) /**/
RTS_SYMBOLS
+RTS_LONG_LONG_SYMS
+RTS_POSIX_ONLY_SYMBOLS
+RTS_MINGW_ONLY_SYMBOLS
#undef Sym
#undef SymX
(void*)(&(vvv)) },
#define SymX(vvv) Sym(vvv)
-static SymbolVal rtsSyms[] = {
+static RtsSymbolVal rtsSyms[] = {
RTS_SYMBOLS
RTS_LONG_LONG_SYMS
+ RTS_POSIX_ONLY_SYMBOLS
+ RTS_MINGW_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)
static void *dl_prog_handle;
+#endif
void
initLinker( void )
{
- SymbolVal *sym;
+ RtsSymbolVal *sym;
symhash = allocStrHashTable();
/* populate the symbol table with stuff from the RTS */
for (sym = rtsSyms; sym->lbl != NULL; sym++) {
- insertStrHashTable(symhash, sym->lbl, sym);
+ ghciInsertStrHashTable("(GHCi built-in symbols)",
+ symhash, sym->lbl, sym->addr);
}
-
+# if defined(OBJFORMAT_ELF)
dl_prog_handle = dlopen(NULL, RTLD_LAZY);
+# endif
+}
+
+/* -----------------------------------------------------------------------------
+ * 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
+ * linked list. When looking for a symbol, try all handles in the
+ * list.
+ */
+
+#if defined(OBJFORMAT_PEi386)
+/* A record for storing handles into DLLs. */
+
+typedef
+ struct _OpenedDLL {
+ 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 )
+{
+# if defined(OBJFORMAT_ELF)
+ 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);
+ if (hdl == NULL) {
+ /* dlopen failed; return a ptr to the error msg. */
+ errmsg = dlerror();
+ if (errmsg == NULL) errmsg = "addDLL: unknown error";
+ return errmsg;
+ } else {
+ return NULL;
+ }
+ /*NOTREACHED*/
+
+# elif defined(OBJFORMAT_PEi386)
+
+ /* 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); */
+
+ /* See if we've already got it, and ignore if so. */
+ for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
+ if (0 == strcmp(o_dll->name, dll_name))
+ return NULL;
+ }
+
+ 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";
+ }
+
+ o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
+ o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
+ strcpy(o_dll->name, dll_name);
+ o_dll->instance = instance;
+ o_dll->next = opened_dlls;
+ opened_dlls = o_dll;
+
+ return NULL;
+# else
+ barf("addDLL: not implemented on this platform");
+# endif
}
/* -----------------------------------------------------------------------------
void *
lookupSymbol( char *lbl )
{
- SymbolVal *val;
+ void *val;
+ ASSERT(symhash != NULL);
val = lookupStrHashTable(symhash, lbl);
if (val == NULL) {
+# if defined(OBJFORMAT_ELF)
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) {
+ /*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) {
+ /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
+ return sym;
+ }
+ }
+ return NULL;
+# else
+ ASSERT(2+2 == 5);
+ return NULL;
+# endif
+ } else {
+ return val;
+ }
+}
+
+static
+void *
+lookupLocalSymbol( ObjectCode* oc, char *lbl )
+{
+ void *val;
+ val = lookupStrHashTable(oc->lochash, lbl);
+
+ if (val == NULL) {
+ return NULL;
} else {
- return val->addr;
+ return val;
}
}
+
+/* -----------------------------------------------------------------------------
+ * 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
+
+
/* -----------------------------------------------------------------------------
* Load an obj (populate the global symbol table, but don't resolve yet)
*
int r, n;
FILE *f;
-#ifdef DEBUG
- /* assert that we haven't already loaded this object */
+ /* fprintf(stderr, "loadObj %s\n", path ); */
+
+ /* 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)");
-# if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
+# if defined(OBJFORMAT_ELF)
oc->formatName = "ELF";
-# elif defined(cygwin32_TARGET_OS)
+# elif defined(OBJFORMAT_PEi386)
oc->formatName = "PEi386";
# else
free(oc);
r = stat(path, &st);
if (r == -1) { return 0; }
- oc->fileName = path;
+ /* sigh, strdup() isn't a POSIX function, so do it the long way */
+ oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
+ strcpy(oc->fileName, path);
+
oc->fileSize = st.st_size;
oc->image = stgMallocBytes( st.st_size, "loadObj(image)" );
oc->symbols = NULL;
oc->sections = NULL;
+ oc->lochash = allocStrHashTable();
+ oc->proddables = NULL;
/* chain it onto the list of objects */
oc->next = objects;
}
/* verify the in-memory image */
-# if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
+# if defined(OBJFORMAT_ELF)
r = ocVerifyImage_ELF ( oc );
-# elif defined(cygwin32_TARGET_OS)
+# elif defined(OBJFORMAT_PEi386)
r = ocVerifyImage_PEi386 ( oc );
# else
barf("loadObj: no verify method");
if (!r) { return r; }
/* build the symbol list for this image */
-# if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
+# if defined(OBJFORMAT_ELF)
r = ocGetNames_ELF ( oc );
-# elif defined(cygwin32_TARGET_OS)
+# elif defined(OBJFORMAT_PEi386)
r = ocGetNames_PEi386 ( oc );
# else
barf("loadObj: no getNames method");
for (oc = objects; oc; oc = oc->next) {
if (oc->status != OBJECT_RESOLVED) {
-# if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
+# if defined(OBJFORMAT_ELF)
r = ocResolve_ELF ( oc );
-# elif defined(cygwin32_TARGET_OS)
+# elif defined(OBJFORMAT_PEi386)
r = ocResolve_PEi386 ( oc );
-# else
- barf("link: not implemented on this platform");
-# endif
+# else
+ barf("resolveObjs: not implemented on this platform");
+# endif
if (!r) { return r; }
oc->status = OBJECT_RESOLVED;
}
HsInt
unloadObj( char *path )
{
- ObjectCode *oc;
+ ObjectCode *oc, *prev;
- for (oc = objects; oc; oc = oc->next) {
+ ASSERT(symhash != NULL);
+ ASSERT(objects != NULL);
+
+ prev = NULL;
+ for (oc = objects; oc; prev = oc, oc = oc->next) {
if (!strcmp(oc->fileName,path)) {
/* Remove all the mappings for the symbols within this
* object..
*/
{
- SymbolVal *s;
- for (s = oc->symbols; s < oc->symbols + oc->n_symbols; s++) {
- removeStrHashTable(symhash, s->lbl, NULL);
- }
+ int i;
+ for (i = 0; i < oc->n_symbols; i++) {
+ if (oc->symbols[i] != NULL) {
+ removeStrHashTable(symhash, oc->symbols[i], NULL);
+ }
+ }
+ }
+
+ if (prev == NULL) {
+ objects = oc->next;
+ } else {
+ prev->next = oc->next;
}
/* We're going to leave this in place, in case there are
any pointers from the heap into it: */
/* free(oc->image); */
+ free(oc->fileName);
free(oc->symbols);
free(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);
return 1;
}
}
-
+
belch("unloadObj: can't find `%s' to unload", path);
return 0;
}
+/* -----------------------------------------------------------------------------
+ * Sanity checking. For each ObjectCode, maintain a list of address ranges
+ * which may be prodded during relocation, and abort if we try and write
+ * outside any of these.
+ */
+static void addProddableBlock ( ObjectCode* oc, void* start, int size )
+{
+ ProddableBlock* pb
+ = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
+ /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
+ ASSERT(size > 0);
+ pb->start = start;
+ pb->size = size;
+ pb->next = oc->proddables;
+ oc->proddables = pb;
+}
+
+static void checkProddableBlock ( ObjectCode* oc, void* addr )
+{
+ ProddableBlock* pb;
+ for (pb = oc->proddables; pb != NULL; pb = pb->next) {
+ char* s = (char*)(pb->start);
+ char* e = s + pb->size - 1;
+ char* a = (char*)addr;
+ /* Assumes that the biggest fixup involves a 4-byte write. This
+ probably needs to be changed to 8 (ie, +7) on 64-bit
+ plats. */
+ if (a >= s && (a+3) <= e) return;
+ }
+ 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;
+}
+
+
+
/* --------------------------------------------------------------------------
- * PEi386 specifics (cygwin32)
+ * PEi386 specifics (Win32 targets)
* ------------------------------------------------------------------------*/
/* The information for this linker comes from
*/
-#if defined(cygwin32_TARGET_OS)
+#if defined(OBJFORMAT_PEi386)
/* From PE spec doc, section 3.3.2 */
-#define IMAGE_FILE_RELOCS_STRIPPED 0x0001
-#define IMAGE_FILE_EXECUTABLE_IMAGE 0x0002
-#define IMAGE_FILE_DLL 0x2000
-#define IMAGE_FILE_SYSTEM 0x1000
-#define IMAGE_FILE_BYTES_REVERSED_HI 0x8000
-#define IMAGE_FILE_BYTES_REVERSED_LO 0x0080
-#define IMAGE_FILE_32BIT_MACHINE 0x0100
+/* Note use of MYIMAGE_* since IMAGE_* are already defined in
+ windows.h -- for the same purpose, but I want to know what I'm
+ getting, here. */
+#define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
+#define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
+#define MYIMAGE_FILE_DLL 0x2000
+#define MYIMAGE_FILE_SYSTEM 0x1000
+#define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
+#define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
+#define MYIMAGE_FILE_32BIT_MACHINE 0x0100
/* From PE spec doc, section 5.4.2 and 5.4.4 */
-#define IMAGE_SYM_CLASS_EXTERNAL 2
-#define IMAGE_SYM_CLASS_STATIC 3
-#define IMAGE_SYM_UNDEFINED 0
+#define MYIMAGE_SYM_CLASS_EXTERNAL 2
+#define MYIMAGE_SYM_CLASS_STATIC 3
+#define MYIMAGE_SYM_UNDEFINED 0
/* From PE spec doc, section 4.1 */
-#define IMAGE_SCN_CNT_CODE 0x00000020
-#define IMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
+#define MYIMAGE_SCN_CNT_CODE 0x00000020
+#define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
/* From PE spec doc, section 5.2.1 */
-#define IMAGE_REL_I386_DIR32 0x0006
-#define IMAGE_REL_I386_REL32 0x0014
+#define MYIMAGE_REL_I386_DIR32 0x0006
+#define MYIMAGE_REL_I386_REL32 0x0014
/* We use myindex to calculate array addresses, rather than
are just plain wrong. Sigh.
*/
static UChar *
-myindex ( int scale, int index, void* base )
+myindex ( int scale, void* base, int index )
{
return
((UChar*)base) + scale * index;
/* The annoying case: 8 bytes. Copy into a temporary
(which is never freed ...)
*/
- newstr = malloc(9);
- if (newstr) {
- strncpy(newstr,name,8);
- newstr[8] = 0;
- }
+ newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
+ ASSERT(newstr);
+ strncpy(newstr,name,8);
+ newstr[8] = 0;
return newstr;
}
UChar* n2;
COFF_section* section_i
= (COFF_section*)
- myindex ( sizeof_COFF_section, i, sectab );
+ 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] &&
static void
zapTrailingAtSign ( UChar* sym )
{
+# define my_isdigit(c) ((c) >= '0' && (c) <= '9')
int i, j;
if (sym[0] == 0) return;
i = 0;
while (sym[i] != 0) i++;
i--;
j = i;
- while (j > 0 && isdigit(sym[j])) j--;
+ while (j > 0 && my_isdigit(sym[j])) j--;
if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
+# undef my_isdigit
}
COFF_section* sectab;
COFF_symbol* symtab;
UChar* strtab;
-
+ /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
hdr = (COFF_header*)(oc->image);
sectab = (COFF_section*) (
((UChar*)(oc->image))
((UChar*)(oc->image))
+ hdr->PointerToSymbolTable
);
- strtab = ((UChar*)(oc->image))
- + hdr->PointerToSymbolTable
+ strtab = ((UChar*)symtab)
+ hdr->NumberOfSymbols * sizeof_COFF_symbol;
if (hdr->Machine != 0x14c) {
- oc->errMsg("Not x86 PEi386");
- return FALSE;
+ belch("Not x86 PEi386");
+ return 0;
}
if (hdr->SizeOfOptionalHeader != 0) {
- oc->errMsg("PEi386 with nonempty optional header");
- return FALSE;
+ belch("PEi386 with nonempty optional header");
+ return 0;
+ }
+ if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
+ (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
+ (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
+ (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
+ belch("Not a PEi386 object file");
+ return 0;
}
- if ( /* (hdr->Characteristics & IMAGE_FILE_RELOCS_STRIPPED) || */
- (hdr->Characteristics & IMAGE_FILE_EXECUTABLE_IMAGE) ||
- (hdr->Characteristics & IMAGE_FILE_DLL) ||
- (hdr->Characteristics & IMAGE_FILE_SYSTEM) ) {
- oc->errMsg("Not a PEi386 object file");
- return FALSE;
+ if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
+ /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
+ belch("Invalid PEi386 word size or endiannness: %d",
+ (int)(hdr->Characteristics));
+ return 0;
}
- if ( (hdr->Characteristics & IMAGE_FILE_BYTES_REVERSED_HI) ||
- !(hdr->Characteristics & IMAGE_FILE_32BIT_MACHINE) ) {
- oc->errMsg("Invalid PEi386 word size or endiannness");
- return FALSE;
+ /* 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 > 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;
}
- if (!verb) return TRUE;
/* No further verification after this point; only debug printing. */
+ i = 0;
+ IF_DEBUG(linker, i=1);
+ if (i == 0) return 1;
fprintf ( stderr,
"sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
fprintf ( stderr,
"characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
- 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 < *(UInt32*)strtab; i++) {
- if (strtab[i] == 0)
- fprintf ( stderr, "\n"); else
- fprintf( stderr, "%c", strtab[i] );
- }
- fprintf ( stderr, "--- END of string table---\n");
-
+ /* Print the section table. */
fprintf ( stderr, "\n" );
for (i = 0; i < hdr->NumberOfSections; i++) {
COFF_reloc* reltab;
COFF_section* sectab_i
= (COFF_section*)
- myindex ( sizeof_COFF_section, i, sectab );
+ myindex ( sizeof_COFF_section, sectab, i );
fprintf ( stderr,
"\n"
"section %d\n"
" data sz %d\n"
" data off %d\n"
" num rel %d\n"
- " off rel %d\n",
+ " off rel %d\n"
+ " ptr raw 0x%x\n",
sectab_i->VirtualSize,
sectab_i->VirtualAddress,
sectab_i->SizeOfRawData,
sectab_i->PointerToRawData,
sectab_i->NumberOfRelocations,
- sectab_i->PointerToRelocations
+ sectab_i->PointerToRelocations,
+ sectab_i->PointerToRawData
);
reltab = (COFF_reloc*) (
((UChar*)(oc->image)) + sectab_i->PointerToRelocations
);
+
for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
COFF_symbol* sym;
COFF_reloc* rel = (COFF_reloc*)
- myindex ( sizeof_COFF_reloc, j, reltab );
+ myindex ( sizeof_COFF_reloc, reltab, j );
fprintf ( stderr,
" type 0x%-4x vaddr 0x%-8x name `",
(UInt32)rel->Type,
rel->VirtualAddress );
sym = (COFF_symbol*)
- myindex ( sizeof_COFF_symbol, rel->SymbolTableIndex, symtab );
- printName ( sym->Name, strtab );
+ myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
+ printName ( sym->Name, strtab -10 );
fprintf ( stderr, "'\n" );
}
+
fprintf ( stderr, "\n" );
}
-
+ 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
+ fprintf( stderr, "%c", strtab[i] );
+ }
+ fprintf ( stderr, "--- END of string table---\n");
fprintf ( stderr, "\n" );
i = 0;
while (1) {
COFF_symbol* symtab_i;
- if (i >= hdr->NumberOfSymbols) break;
+ if (i >= (Int32)(hdr->NumberOfSymbols)) break;
symtab_i = (COFF_symbol*)
- myindex ( sizeof_COFF_symbol, i, symtab );
+ myindex ( sizeof_COFF_symbol, symtab, i );
fprintf ( stderr,
"symbol %d\n"
" name `",
fprintf ( stderr,
"'\n"
" value 0x%x\n"
- " sec# %d\n"
+ " 1+sec# %d\n"
" type 0x%x\n"
" sclass 0x%x\n"
" nAux %d\n",
symtab_i->Value,
- (Int32)(symtab_i->SectionNumber) - 1,
+ (Int32)(symtab_i->SectionNumber),
(UInt32)symtab_i->Type,
(UInt32)symtab_i->StorageClass,
(UInt32)symtab_i->NumberOfAuxSymbols
}
fprintf ( stderr, "\n" );
-
- return TRUE;
+ return 1;
}
+ hdr->PointerToSymbolTable
+ hdr->NumberOfSymbols * sizeof_COFF_symbol;
- /* Copy exported symbols into the ObjectCode. */
- i = 0;
- while (1) {
- COFF_symbol* symtab_i;
- if (i >= hdr->NumberOfSymbols) break;
- symtab_i = (COFF_symbol*)
- myindex ( sizeof_COFF_symbol, i, symtab );
-
- if (symtab_i->StorageClass == IMAGE_SYM_CLASS_EXTERNAL &&
- symtab_i->SectionNumber != IMAGE_SYM_UNDEFINED) {
-
- /* This symbol is global and defined, viz, exported */
- COFF_section* sectabent;
-
- sname = cstring_from_COFF_symbol_name (
- symtab_i->Name, strtab
- );
- if (!sname) {
- oc->errMsg("Out of memory when copying PEi386 symbol");
- return FALSE;
- }
+ /* Allocate space for any (local, anonymous) .bss sections. */
- /* for IMAGE_SYMCLASS_EXTERNAL
- && !IMAGE_SYM_UNDEFINED,
- the address of the symbol is:
- address of relevant section + offset in section
- */
- sectabent = (COFF_section*)
- myindex ( sizeof_COFF_section,
- symtab_i->SectionNumber-1,
- sectab );
- addr = ((UChar*)(oc->image))
- + (sectabent->PointerToRawData
- + symtab_i->Value);
- /* fprintf ( stderr, "addSymbol %p `%s'\n", addr,sname); */
- if (!addSymbol(oc,sname,addr)) return FALSE;
- }
- i += symtab_i->NumberOfAuxSymbols;
- i++;
+ for (i = 0; i < hdr->NumberOfSections; i++) {
+ UChar* zspace;
+ COFF_section* sectab_i
+ = (COFF_section*)
+ myindex ( sizeof_COFF_section, sectab, i );
+ if (0 != strcmp(sectab_i->Name, ".bss")) continue;
+ if (sectab_i->VirtualSize == 0) continue;
+ /* 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,
+ "ocGetNames_PEi386(anonymous bss)");
+ sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
+ addProddableBlock(oc, zspace, sectab_i->VirtualSize);
+ /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
}
- oc->sections = stgMallocBytes( NumberOfSections * sizeof(Section),
- "ocGetNamesPEi386" );
-
/* 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, i, sectab );
- /* fprintf ( stderr, "section name = %s\n", sectab_i->Name ); */
+ myindex ( sizeof_COFF_section, sectab, i );
+ IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
-#if 0
+# 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 & IMAGE_SCN_CNT_CODE ||
- sectab_i->Characteristics & IMAGE_SCN_CNT_INITIALIZED_DATA)
+ if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
+ sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
kind = SECTIONKIND_CODE_OR_RODATA;
-#endif
+# endif
- if (0==strcmp(".text",sectab_i->Name))
+ 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;
+ 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->n_symbols = hdr->NumberOfSymbols;
+ 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++)
+ oc->symbols[i] = NULL;
+
+ i = 0;
+ while (1) {
+ COFF_symbol* symtab_i;
+ if (i >= (Int32)(hdr->NumberOfSymbols)) break;
+ symtab_i = (COFF_symbol*)
+ myindex ( sizeof_COFF_symbol, symtab, i );
+
+ addr = NULL;
- if (kind != SECTIONKIND_OTHER) {
- addSection ( oc, start, end, kind );
+ 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
+ && !MYIMAGE_SYM_UNDEFINED,
+ the address of the symbol is:
+ address of relevant section + offset in 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,
+ "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) {
+ sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
+ /* 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;
+ ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
} else {
- fprintf ( stderr, "unknown section name = `%s'\n",
- sectab_i->Name);
- oc->errMsg("Unknown PEi386 section name");
- return FALSE;
+# if 0
+ fprintf ( stderr,
+ "IGNORING symbol %d\n"
+ " name `",
+ i
+ );
+ printName ( symtab_i->Name, strtab );
+ fprintf ( stderr,
+ "'\n"
+ " value 0x%x\n"
+ " 1+sec# %d\n"
+ " type 0x%x\n"
+ " sclass 0x%x\n"
+ " nAux %d\n",
+ symtab_i->Value,
+ (Int32)(symtab_i->SectionNumber),
+ (UInt32)symtab_i->Type,
+ (UInt32)symtab_i->StorageClass,
+ (UInt32)symtab_i->NumberOfAuxSymbols
+ );
+# endif
}
+
+ i += symtab_i->NumberOfAuxSymbols;
+ i++;
}
- return TRUE;
+ return 1;
}
static int
-ocResolve_PEi386 ( ObjectCode* oc, int verb )
+ocResolve_PEi386 ( ObjectCode* oc )
{
COFF_header* hdr;
COFF_section* sectab;
UInt32* pP;
int i, j;
- char symbol[1000]; // ToDo
-
+
+ /* ToDo: should be variable-sized? But is at least safe in the
+ sense of buffer-overrun-proof. */
+ char symbol[1000];
+ /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
+
hdr = (COFF_header*)(oc->image);
sectab = (COFF_section*) (
((UChar*)(oc->image))
for (i = 0; i < hdr->NumberOfSections; i++) {
COFF_section* sectab_i
= (COFF_section*)
- myindex ( sizeof_COFF_section, i, sectab );
+ myindex ( sizeof_COFF_section, sectab, i );
COFF_reloc* reltab
= (COFF_reloc*) (
((UChar*)(oc->image)) + sectab_i->PointerToRelocations
);
+
+ /* Ignore sections called which contain stabs debugging
+ information. */
+ if (0 == strcmp(".stab", sectab_i->Name)
+ || 0 == strcmp(".stabstr", sectab_i->Name))
+ continue;
+
for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
COFF_symbol* sym;
COFF_reloc* reltab_j
= (COFF_reloc*)
- myindex ( sizeof_COFF_reloc, j, reltab );
+ myindex ( sizeof_COFF_reloc, reltab, j );
/* the location to patch */
pP = (UInt32*)(
((UChar*)(oc->image))
+ (sectab_i->PointerToRawData
- + reltab_j->VirtualAddress)
+ + reltab_j->VirtualAddress
+ - sectab_i->VirtualAddress )
);
/* the existing contents of pP */
A = *pP;
/* the symbol to connect to */
sym = (COFF_symbol*)
myindex ( sizeof_COFF_symbol,
- reltab_j->SymbolTableIndex, symtab );
- if (verb) {
- fprintf ( stderr,
- "reloc sec %2d num %3d: type 0x%-4x "
- "vaddr 0x%-8x name `",
- i, j,
- (UInt32)reltab_j->Type,
- reltab_j->VirtualAddress );
- printName ( sym->Name, strtab );
- fprintf ( stderr, "'\n" );
- }
-
- if (sym->StorageClass == IMAGE_SYM_CLASS_STATIC) {
+ symtab, reltab_j->SymbolTableIndex );
+ IF_DEBUG(linker,
+ fprintf ( stderr,
+ "reloc sec %2d num %3d: type 0x%-4x "
+ "vaddr 0x%-8x name `",
+ i, j,
+ (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
= findPEi386SectionCalled ( oc, sym->Name );
if (!section_sym) {
- fprintf ( stderr, "bad section = `%s'\n", sym->Name );
- oc->errMsg("Can't find abovementioned PEi386 section");
- return FALSE;
+ belch("%s: can't find section `%s'", oc->fileName, sym->Name);
+ return 0;
}
S = ((UInt32)(oc->image))
+ (section_sym->PointerToRawData
+ sym->Value);
} else {
- copyName ( sym->Name, strtab, symbol, 1000 );
- zapTrailingAtSign ( symbol );
- S = (UInt32) ocLookupSym ( oc, symbol );
- if (S == 0)
- S = (UInt32)(oc->clientLookup ( symbol ));
- if (S == 0) {
- belch("%s: unresolvable reference to `%s'", oc->fileName, symbol);
- return FALSE;
+ 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) 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 IMAGE_REL_I386_DIR32:
+ case MYIMAGE_REL_I386_DIR32:
*pP = A + S;
break;
- case IMAGE_REL_I386_REL32:
+ case MYIMAGE_REL_I386_REL32:
/* Tricky. We have to insert a displacement at
pP which, when added to the PC for the _next_
insn, gives the address of the target (S).
*pP = S - ((UInt32)pP) - 4;
break;
default:
- fprintf(stderr,
- "unhandled PEi386 relocation type %d\n",
- reltab_j->Type);
- oc->errMsg("unhandled PEi386 relocation type");
- return FALSE;
+ belch("%s: unhandled PEi386 relocation type %d",
+ oc->fileName, reltab_j->Type);
+ return 0;
}
}
}
- return TRUE;
+ IF_DEBUG(linker, belch("completed %s", oc->fileName));
+ return 1;
}
-#endif /* defined(cygwin32_TARGET_OS) */
+#endif /* defined(OBJFORMAT_PEi386) */
/* --------------------------------------------------------------------------
- * ELF specifics (Linux, Solaris)
+ * ELF specifics
* ------------------------------------------------------------------------*/
-#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
+#if defined(OBJFORMAT_ELF)
#define FALSE 0
#define TRUE 1
+#if defined(sparc_TARGET_ARCH)
+# define ELF_TARGET_SPARC /* Used inside <elf.h> */
+#elif defined(i386_TARGET_ARCH)
+# define ELF_TARGET_386 /* Used inside <elf.h> */
+#endif
+/* There is a similar case for IA64 in the Solaris2 headers if this
+ * ever becomes relevant.
+ */
+
#include <elf.h>
static char *
{
int i;
char* ehdrC = (char*)objImage;
- Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC;
- Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
+ Elf32_Ehdr* ehdr = (Elf32_Ehdr*)ehdrC;
+ Elf32_Shdr* shdr = (Elf32_Shdr*)(ehdrC + ehdr->e_shoff);
+ char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
char* ptr = NULL;
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 != strcmp(".stabstr", sh_strtab + shdr[i].sh_name)
+ ) {
ptr = ehdrC + shdr[i].sh_offset;
break;
}
ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
ehdr->e_ident[EI_MAG3] != ELFMAG3) {
- belch("ocVerifyImage_ELF: not an ELF header");
+ belch("%s: not an ELF header", oc->fileName);
return 0;
}
IF_DEBUG(linker,belch( "Is an ELF header" ));
if (ehdr->e_ident[EI_CLASS] != ELFCLASS32) {
- belch("ocVerifyImage_ELF: not 32 bit ELF" );
+ belch("%s: not 32 bit ELF", oc->fileName);
return 0;
}
if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
IF_DEBUG(linker,belch( "Is big-endian" ));
} else {
- belch("ocVerifyImage_ELF: unknown endiannness");
+ belch("%s: unknown endiannness", oc->fileName);
return 0;
}
if (ehdr->e_type != ET_REL) {
- belch("ocVerifyImage_ELF: not a relocatable object (.o) file");
+ belch("%s: not a relocatable object (.o) file", oc->fileName);
return 0;
}
IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
default: IF_DEBUG(linker,belch( "unknown" ));
- belch("ocVerifyImage_ELF: unknown architecture");
+ belch("%s: unknown architecture", oc->fileName);
return 0;
}
shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
if (ehdr->e_shstrndx == SHN_UNDEF) {
- belch("ocVerifyImage_ELF: no section header string table");
+ belch("%s: no section header string table", oc->fileName);
return 0;
} else {
IF_DEBUG(linker,belch( "Section header string table is section %d",
for (i = 0; i < ehdr->e_shnum; i++) {
IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
- IF_DEBUG(linker,fprintf(stderr, "type=%2d ", shdr[i].sh_type ));
- IF_DEBUG(linker,fprintf(stderr, "size=%4d ", shdr[i].sh_size ));
- IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", shdr[i].sh_offset ));
+ IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
+ 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 + shdr[i].sh_size - 1));
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 != strcmp(".stabstr", sh_strtab + shdr[i].sh_name)
+ ) {
+ IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
strtab = ehdrC + shdr[i].sh_offset;
nstrtab++;
}
}
if (nstrtab != 1) {
- belch("ocVerifyImage_ELF: no string tables, or too many");
+ belch("%s: no string tables, or too many", oc->fileName);
return 0;
}
shdr[i].sh_size % sizeof(Elf32_Sym)
));
if (0 != shdr[i].sh_size % sizeof(Elf32_Sym)) {
- belch("ocVerifyImage_ELF: non-integral number of symbol table entries");
+ belch("%s: non-integral number of symbol table entries", oc->fileName);
return 0;
}
for (j = 0; j < nent; j++) {
}
if (nsymtabs == 0) {
- belch("ocVerifyImage_ELF: didn't find any symbol tables");
+ belch("%s: didn't find any symbol tables", oc->fileName);
return 0;
}
Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
+ ASSERT(symhash != NULL);
+
if (!strtab) {
- belch("ocGetNames_ELF: no strtab");
+ belch("%s: no strtab", oc->fileName);
return 0;
}
k = 0;
- oc->sections = stgMallocBytes( ehdr->e_shnum * sizeof(Section),
- "ocGetNames_ELF" );
- oc->n_sections = ehdr->e_shnum;
-
for (i = 0; i < ehdr->e_shnum; 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(".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) {
+ /* This is a non-empty .bss section. Allocate zeroed space for
+ 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(BSS)");
+ shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
+ /*
+ 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;
-
+ 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)
+ addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
+
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);
- oc->symbols = malloc(nent * sizeof(SymbolVal));
+
+ oc->n_symbols = nent;
+ 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 ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL
+ || ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL
)
- /* and not an undefined symbol */
- && stab[j].st_shndx != SHN_UNDEF
- &&
+ /* and not an undefined symbol */
+ && stab[j].st_shndx != SHN_UNDEF
+ /* and not in a "special section" */
+ && stab[j].st_shndx < SHN_LORESERVE
+ &&
/* and it's a not a section or string table or anything silly */
( 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 )
- ) {
- char* nm = strtab + stab[j].st_name;
- char* ad = ehdrC
- + shdr[ stab[j].st_shndx ].sh_offset
- + stab[j].st_value;
+ ELF32_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",
+ 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 ));
+ isLocal = TRUE;
+ } else {
+ IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
+ ad, oc->fileName, nm ));
+ isLocal = FALSE;
+ }
+ }
+
+ /* And the decision is ... */
+
+ if (ad != NULL) {
ASSERT(nm != NULL);
- ASSERT(ad != NULL);
- IF_DEBUG(linker,belch( "addOTabName: %10p %s %s",
- ad, oc->fileName, nm ));
- oc->symbols[j].lbl = nm;
- oc->symbols[j].addr = ad;
- insertStrHashTable(symhash, nm, &(oc->symbols[j]));
+ oc->symbols[j] = nm;
+ /* Acquire! */
+ if (isLocal) {
+ ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, ad);
+ } else {
+ ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
+ }
+ } else {
+ /* Skip. */
+ IF_DEBUG(linker,belch( "skipping `%s'",
+ strtab + stab[j].st_name ));
+ /*
+ 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)stab[j].st_shndx,
+ strtab + stab[j].st_name
+ );
+ */
+ oc->symbols[j] = NULL;
}
- else {
- IF_DEBUG(linker,belch( "skipping `%s'", strtab +
- stab[j].st_name ));
- oc->symbols[j].lbl = NULL;
- oc->symbols[j].addr = NULL;
- }
+
}
}
}
+/* 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 )
+{
+ 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);
+ 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);
+ 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_Addr P = ((Elf32_Addr)targ) + offset;
+ Elf32_Word* pP = (Elf32_Word*)P;
+ Elf32_Addr A = *pP;
+ Elf32_Addr S;
+
+ 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 );
+ }
+ 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 ));
+ checkProddableBlock ( oc, pP );
+ switch (ELF32_R_TYPE(info)) {
+# ifdef i386_TARGET_ARCH
+ case R_386_32: *pP = S + A; break;
+ case R_386_PC32: *pP = S + A - P; break;
+# endif
+ default:
+ belch("%s: unhandled ELF relocation(Rel) type %d\n",
+ oc->fileName, ELF32_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 )
+{
+ 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);
+ 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);
+ 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)
+ /* This #ifdef only serves to avoid unused-var warnings. */
+ Elf32_Word* pP = (Elf32_Word*)P;
+ Elf32_Word w1, w2;
+# endif
+
+ IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
+ j, (void*)offset, (void*)info,
+ (void*)addend ));
+ 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 );
+ }
+ 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)) {
+# if defined(sparc_TARGET_ARCH)
+ case R_SPARC_WDISP30:
+ w1 = *pP & 0xC0000000;
+ w2 = (Elf32_Word)((S + A - P) >> 2);
+ ASSERT((w2 & 0xC0000000) == 0);
+ w1 |= w2;
+ *pP = w1;
+ break;
+ case R_SPARC_HI22:
+ w1 = *pP & 0xFFC00000;
+ w2 = (Elf32_Word)((S + A) >> 10);
+ ASSERT((w2 & 0xFFC00000) == 0);
+ w1 |= w2;
+ *pP = w1;
+ break;
+ case R_SPARC_LO10:
+ w1 = *pP & ~0x3FF;
+ w2 = (Elf32_Word)((S + A) & 0x3FF);
+ ASSERT((w2 & ~0x3FF) == 0);
+ w1 |= w2;
+ *pP = w1;
+ break;
+ /* According to the Sun documentation:
+ 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 ...)
+ */
+ case R_SPARC_UA32:
+ case R_SPARC_32:
+ w2 = (Elf32_Word)(S + A);
+ *pP = w2;
+ break;
+# endif
+ default:
+ belch("%s: unhandled ELF relocation(RelA) type %d\n",
+ oc->fileName, ELF32_R_TYPE(info));
+ return 0;
+ }
+
+ }
+ return 1;
+}
+
+
static int
ocResolve_ELF ( ObjectCode* oc )
{
- char *strtab, *symbol;
- int i, j;
+ 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);
- Elf32_Word* targ;
+ char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
/* first find "the" symbol table */
stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
strtab = findElfSection ( ehdrC, SHT_STRTAB );
if (stab == NULL || strtab == NULL) {
- belch("ocResolve_ELF: can't find string or symbol table");
+ belch("%s: can't find string or symbol table", oc->fileName);
return 0;
}
- for (i = 0; i < ehdr->e_shnum; i++) {
- if (shdr[i].sh_type == SHT_REL ) {
- Elf32_Rel* rtab = (Elf32_Rel*) (ehdrC + shdr[i].sh_offset);
- int nent = shdr[i].sh_size / sizeof(Elf32_Rel);
- int target_shndx = shdr[i].sh_info;
- int symtab_shndx = shdr[i].sh_link;
- stab = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
- targ = (Elf32_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;
-
- Elf32_Addr P = ((Elf32_Addr)targ) + offset;
- Elf32_Word* pP = (Elf32_Word*)P;
- Elf32_Addr A = *pP;
- Elf32_Addr S;
-
- 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 the symbol table then. */
- symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
- (void *)S = lookupSymbol( symbol );
- }
- if (!S) {
- barf("ocResolve_ELF: %s: unknown symbol `%s'",
- oc->fileName, symbol);
- }
- 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 ));
- switch (ELF32_R_TYPE(info)) {
- case R_386_32: *pP = S + A; break;
- case R_386_PC32: *pP = S + A - P; break;
- default: fprintf(stderr,
- "unhandled ELF relocation type %d",
- ELF32_R_TYPE(info));
- belch("ocResolve_ELF: unhandled ELF relocation type");
- 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 == strcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name))
+ continue;
+
+ if (shdr[shnum].sh_type == SHT_REL ) {
+ ok = do_Elf32_Rel_relocations ( oc, ehdrC, shdr,
+ shnum, stab, strtab );
+ if (!ok) return ok;
}
else
- if (shdr[i].sh_type == SHT_RELA) {
- belch("ocResolve_ELF: RelA style reloc table -- not yet done");
- return 0;
+ if (shdr[shnum].sh_type == SHT_RELA) {
+ ok = do_Elf32_Rela_relocations ( oc, ehdrC, shdr,
+ shnum, stab, strtab );
+ if (!ok) return ok;
}
- }
-
- return 1;
-}
-
-
-#endif /* defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) */
-/* -----------------------------------------------------------------------------
- * Look up an address to discover whether it is in text or data space.
- *
- * Used by the garbage collector when walking the stack.
- * -------------------------------------------------------------------------- */
-
-static __inline__ SectionKind
-lookupSection ( void* addr )
-{
- int i;
- ObjectCode* oc;
-
- for ( oc = objects; oc; oc = oc->next ) {
- for (i = 0; i < oc->n_sections; i++) {
- if (oc->sections[i].start <= addr
- && addr <= oc->sections[i].end)
- return oc->sections[i].kind;
- }
}
- return SECTIONKIND_OTHER;
-}
-
-int
-is_dynamically_loaded_code_or_rodata_ptr ( void* p )
-{
- SectionKind sk = lookupSection(p);
- ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
- return (sk == SECTIONKIND_CODE_OR_RODATA);
-}
+ /* Free the local symbol table; we won't need it again. */
+ freeHashTable(oc->lochash, NULL);
+ oc->lochash = NULL;
-int
-is_dynamically_loaded_rwdata_ptr ( void* p )
-{
- SectionKind sk = lookupSection(p);
- ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
- return (sk == SECTIONKIND_RWDATA);
+ return 1;
}
-int
-is_not_dynamically_loaded_ptr ( void* p )
-{
- SectionKind sk = lookupSection(p);
- ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
- return (sk == SECTIONKIND_OTHER);
-}
-
-#endif /* GHCI */
+#endif /* ELF */