#include "HsFFI.h"
#include "sm/Storage.h"
+#include "Stats.h"
#include "Hash.h"
#include "LinkerInternals.h"
#include "RtsUtils.h"
#include "posix/Signals.h"
#endif
+// get protos for is*()
+#include <ctype.h>
+
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#include <stdlib.h>
#include <string.h>
+#include <stdio.h>
+#include <assert.h>
#ifdef HAVE_SYS_STAT_H
#include <sys/stat.h>
#include <sys/wait.h>
#endif
-#if defined(ia64_HOST_ARCH) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
+#if defined(linux_HOST_OS ) || defined(freebsd_HOST_OS) || \
+ defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS ) || \
+ defined(openbsd_HOST_OS ) || \
+ ( defined(darwin_HOST_OS ) && !defined(powerpc_HOST_ARCH) )
+/* Don't use mmap on powerpc-apple-darwin as mmap doesn't support
+ * reallocating but we need to allocate jump islands just after each
+ * object images. Otherwise relative branches to jump islands can fail
+ * due to 24-bits displacement overflow.
+ */
#define USE_MMAP
#include <fcntl.h>
#include <sys/mman.h>
-#if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
-#endif
#endif
#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
# define OBJFORMAT_ELF
+# include <regex.h> // regex is already used by dlopen() so this is OK
+ // to use here without requiring an additional lib
#elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
# define OBJFORMAT_PEi386
# include <windows.h>
# include <math.h>
#elif defined(darwin_HOST_OS)
# define OBJFORMAT_MACHO
+# include <regex.h>
# include <mach-o/loader.h>
# include <mach-o/nlist.h>
# include <mach-o/reloc.h>
#endif
#endif
+#if defined(x86_64_HOST_ARCH) && defined(darwin_HOST_OS)
+#define ALWAYS_PIC
+#endif
+
/* Hash table mapping symbol names to Symbol */
static /*Str*/HashTable *symhash;
/* List of currently loaded objects */
ObjectCode *objects = NULL; /* initially empty */
+static HsInt loadOc( ObjectCode* oc );
+static ObjectCode* mkOc( char *path, char *image, int imageSize,
+ char *archiveMemberName
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ , int misalignment
+#endif
+#endif
+ );
+
#if defined(OBJFORMAT_ELF)
static int ocVerifyImage_ELF ( ObjectCode* oc );
static int ocGetNames_ELF ( ObjectCode* oc );
static int ocGetNames_MachO ( ObjectCode* oc );
static int ocResolve_MachO ( ObjectCode* oc );
+#ifndef USE_MMAP
static int machoGetMisalignment( FILE * );
+#endif
#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
#endif
* We pick a default address based on the OS, but also make this
* configurable via an RTS flag (+RTS -xm)
*/
-#if defined(x86_64_HOST_ARCH)
+#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
#if defined(MAP_32BIT)
// Try to use MAP_32BIT
#define RTS_POSIX_ONLY_SYMBOLS /**/
#define RTS_CYGWIN_ONLY_SYMBOLS /**/
-/* Extra syms gen'ed by mingw-2's gcc-3.2: */
-#if __GNUC__>=3
-#define RTS_MINGW_EXTRA_SYMS \
- SymI_NeedsProto(_imp____mb_cur_max) \
- SymI_NeedsProto(_imp___pctype)
-#else
-#define RTS_MINGW_EXTRA_SYMS
-#endif
-
#if HAVE_GETTIMEOFDAY
#define RTS_MINGW_GETTIMEOFDAY_SYM SymI_NeedsProto(gettimeofday)
#else
SymI_HasProto(strncpy) \
SymI_HasProto(abort) \
SymI_NeedsProto(_alloca) \
- SymI_NeedsProto(isxdigit) \
- SymI_NeedsProto(isupper) \
- SymI_NeedsProto(ispunct) \
- SymI_NeedsProto(islower) \
- SymI_NeedsProto(isspace) \
- SymI_NeedsProto(isprint) \
- SymI_NeedsProto(isdigit) \
- SymI_NeedsProto(iscntrl) \
- SymI_NeedsProto(isalpha) \
- SymI_NeedsProto(isalnum) \
- SymI_NeedsProto(isascii) \
+ SymI_HasProto(isxdigit) \
+ SymI_HasProto(isupper) \
+ SymI_HasProto(ispunct) \
+ SymI_HasProto(islower) \
+ SymI_HasProto(isspace) \
+ SymI_HasProto(isprint) \
+ SymI_HasProto(isdigit) \
+ SymI_HasProto(iscntrl) \
+ SymI_HasProto(isalpha) \
+ SymI_HasProto(isalnum) \
+ SymI_HasProto(isascii) \
RTS___MINGW_VFPRINTF_SYM \
SymI_HasProto(strcmp) \
SymI_HasProto(memmove) \
SymI_NeedsProto(opendir) \
SymI_NeedsProto(readdir) \
SymI_NeedsProto(rewinddir) \
- RTS_MINGW_EXTRA_SYMS \
+ SymI_NeedsProto(_imp____mb_cur_max) \
+ SymI_NeedsProto(_imp___pctype) \
+ SymI_NeedsProto(__chkstk) \
RTS_MINGW_GETTIMEOFDAY_SYM \
SymI_NeedsProto(closedir)
#endif
-#if defined(darwin_TARGET_OS) && HAVE_PRINTF_LDBLSTUB
+
+#if defined(darwin_HOST_OS) && HAVE_PRINTF_LDBLSTUB
#define RTS_DARWIN_ONLY_SYMBOLS \
SymI_NeedsProto(asprintf$LDBLStub) \
SymI_NeedsProto(err$LDBLStub) \
#if !defined(mingw32_HOST_OS)
#define RTS_USER_SIGNALS_SYMBOLS \
- SymI_HasProto(setIOManagerPipe) \
+ SymI_HasProto(setIOManagerControlFd) \
+ SymI_HasProto(setIOManagerWakeupFd) \
+ SymI_HasProto(ioManagerWakeup) \
SymI_HasProto(blockUserSignals) \
SymI_HasProto(unblockUserSignals)
#else
#define RTS_USER_SIGNALS_SYMBOLS \
+ SymI_HasProto(ioManagerWakeup) \
SymI_HasProto(sendIOManagerEvent) \
SymI_HasProto(readIOManagerEvent) \
SymI_HasProto(getIOManagerEvent) \
SymI_HasProto(RET_SEMI_loads_avoided)
+// On most platforms, the garbage collector rewrites references
+// to small integer and char objects to a set of common, shared ones.
+//
+// We don't do this when compiling to Windows DLLs at the moment because
+// it doesn't support cross package data references well.
+//
+#if defined(__PIC__) && defined(mingw32_HOST_OS)
+#define RTS_INTCHAR_SYMBOLS
+#else
+#define RTS_INTCHAR_SYMBOLS \
+ SymI_HasProto(stg_CHARLIKE_closure) \
+ SymI_HasProto(stg_INTLIKE_closure)
+#endif
+
+
#define RTS_SYMBOLS \
Maybe_Stable_Names \
RTS_TICKY_SYMBOLS \
SymI_HasProto(debugBelch) \
SymI_HasProto(errorBelch) \
SymI_HasProto(sysErrorBelch) \
- SymI_HasProto(stg_asyncExceptionsBlockedzh) \
- SymI_HasProto(stg_blockAsyncExceptionszh) \
+ SymI_HasProto(stg_getMaskingStatezh) \
+ SymI_HasProto(stg_maskAsyncExceptionszh) \
+ SymI_HasProto(stg_maskUninterruptiblezh) \
SymI_HasProto(stg_catchzh) \
SymI_HasProto(stg_catchRetryzh) \
SymI_HasProto(stg_catchSTMzh) \
SymI_HasProto(forkOS_createThread) \
SymI_HasProto(freeHaskellFunctionPtr) \
SymI_HasProto(getOrSetTypeableStore) \
- SymI_HasProto(getOrSetSignalHandlerStore) \
+ SymI_HasProto(getOrSetGHCConcSignalSignalHandlerStore) \
+ SymI_HasProto(getOrSetGHCConcWindowsPendingDelaysStore) \
+ SymI_HasProto(getOrSetGHCConcWindowsIOManagerThreadStore) \
+ SymI_HasProto(getOrSetGHCConcWindowsProddingStore) \
+ SymI_HasProto(getOrSetSystemEventThreadEventManagerStore) \
+ SymI_HasProto(getOrSetSystemEventThreadIOManagerThreadStore) \
SymI_HasProto(genSymZh) \
SymI_HasProto(genericRaise) \
SymI_HasProto(getProgArgv) \
SymI_HasProto(stg_unpackClosurezh) \
SymI_HasProto(stg_getApStackValzh) \
SymI_HasProto(stg_getSparkzh) \
+ SymI_HasProto(stg_numSparkszh) \
SymI_HasProto(stg_isCurrentThreadBoundzh) \
SymI_HasProto(stg_isEmptyMVarzh) \
SymI_HasProto(stg_killThreadzh) \
+ SymI_HasProto(loadArchive) \
SymI_HasProto(loadObj) \
SymI_HasProto(insertStableSymbol) \
SymI_HasProto(insertSymbol) \
SymI_HasProto(rts_unlock) \
SymI_HasProto(rts_unsafeGetMyCapability) \
SymI_HasProto(rtsSupportsBoundThreads) \
+ SymI_HasProto(rts_isProfiled) \
SymI_HasProto(setProgArgv) \
SymI_HasProto(startupHaskell) \
SymI_HasProto(shutdownHaskell) \
SymI_HasProto(stable_ptr_table) \
SymI_HasProto(stackOverflow) \
SymI_HasProto(stg_CAF_BLACKHOLE_info) \
+ SymI_HasProto(stg_BLACKHOLE_info) \
SymI_HasProto(__stg_EAGER_BLACKHOLE_info) \
+ SymI_HasProto(stg_BLOCKING_QUEUE_CLEAN_info) \
+ SymI_HasProto(stg_BLOCKING_QUEUE_DIRTY_info) \
SymI_HasProto(startTimer) \
- SymI_HasProto(stg_CHARLIKE_closure) \
SymI_HasProto(stg_MVAR_CLEAN_info) \
SymI_HasProto(stg_MVAR_DIRTY_info) \
SymI_HasProto(stg_IND_STATIC_info) \
- SymI_HasProto(stg_INTLIKE_closure) \
SymI_HasProto(stg_ARR_WORDS_info) \
SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info) \
SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info) \
SymI_HasProto(stg_sel_8_upd_info) \
SymI_HasProto(stg_sel_9_upd_info) \
SymI_HasProto(stg_upd_frame_info) \
+ SymI_HasProto(stg_bh_upd_frame_info) \
SymI_HasProto(suspendThread) \
SymI_HasProto(stg_takeMVarzh) \
SymI_HasProto(stg_threadStatuszh) \
SymI_HasProto(stg_tryPutMVarzh) \
SymI_HasProto(stg_tryTakeMVarzh) \
- SymI_HasProto(stg_unblockAsyncExceptionszh) \
+ SymI_HasProto(stg_unmaskAsyncExceptionszh) \
SymI_HasProto(unloadObj) \
SymI_HasProto(stg_unsafeThawArrayzh) \
SymI_HasProto(stg_waitReadzh) \
SymI_HasProto(stg_writeTVarzh) \
SymI_HasProto(stg_yieldzh) \
SymI_NeedsProto(stg_interp_constr_entry) \
- SymI_HasProto(alloc_blocks) \
+ SymI_HasProto(stg_arg_bitmaps) \
SymI_HasProto(alloc_blocks_lim) \
- SymI_HasProto(allocateLocal) \
+ SymI_HasProto(g0) \
+ SymI_HasProto(allocate) \
SymI_HasProto(allocateExec) \
SymI_HasProto(freeExec) \
SymI_HasProto(getAllocations) \
SymI_HasProto(n_capabilities) \
SymI_HasProto(stg_traceCcszh) \
SymI_HasProto(stg_traceEventzh) \
- RTS_USER_SIGNALS_SYMBOLS
+ RTS_USER_SIGNALS_SYMBOLS \
+ RTS_INTCHAR_SYMBOLS
// 64-bit support functions in libgcc.a
SymI_NeedsProto(__muldi3) \
SymI_NeedsProto(__ashldi3) \
SymI_NeedsProto(__ashrdi3) \
- SymI_NeedsProto(__lshrdi3) \
- SymI_NeedsProto(__eprintf)
+ SymI_NeedsProto(__lshrdi3)
#else
#define RTS_LIBGCC_SYMBOLS
#endif
/* entirely bogus claims about types of these symbols */
#define SymI_NeedsProto(vvv) extern void vvv(void);
-#if defined(__PIC__) && defined(mingw32_TARGET_OS)
+#if defined(__PIC__) && defined(mingw32_HOST_OS)
#define SymE_HasProto(vvv) SymE_HasProto(vvv);
#define SymE_NeedsProto(vvv) extern void _imp__ ## vvv (void);
#else
(char*)key,
obj_name
);
- exit(1);
+ stg_exit(1);
}
/* -----------------------------------------------------------------------------
* initialize the object linker
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
static void *dl_prog_handle;
+static regex_t re_invalid;
+static regex_t re_realso;
+#ifdef THREADED_RTS
+static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
+#endif
#endif
void
initLinker( void )
{
RtsSymbolVal *sym;
+#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+ int compileResult;
+#endif
+
+ IF_DEBUG(linker, debugBelch("initLinker: start\n"));
/* Make initLinker idempotent, so we can call it
before evey relevant operation; that means we
don't need to initialise the linker separately */
- if (linker_init_done == 1) { return; } else {
- linker_init_done = 1;
+ if (linker_init_done == 1) {
+ IF_DEBUG(linker, debugBelch("initLinker: idempotent return\n"));
+ return;
+ } else {
+ linker_init_done = 1;
}
+#if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO))
+ initMutex(&dl_mutex);
+#endif
stablehash = allocStrHashTable();
symhash = allocStrHashTable();
for (sym = rtsSyms; sym->lbl != NULL; sym++) {
ghciInsertStrHashTable("(GHCi built-in symbols)",
symhash, sym->lbl, sym->addr);
+ IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr));
}
# if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
machoInitSymbolsWithoutUnderscore();
# else
dl_prog_handle = dlopen(NULL, RTLD_LAZY);
# endif /* RTLD_DEFAULT */
+
+ compileResult = regcomp(&re_invalid,
+ "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*invalid ELF header",
+ REG_EXTENDED);
+ ASSERT( compileResult == 0 );
+ compileResult = regcomp(&re_realso,
+ "GROUP *\\( *(([^ )])+)",
+ REG_EXTENDED);
+ ASSERT( compileResult == 0 );
# endif
-#if defined(x86_64_HOST_ARCH)
+#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
if (RtsFlags.MiscFlags.linkerMemBase != 0) {
// User-override for mmap_32bit_base
mmap_32bit_base = (void*)RtsFlags.MiscFlags.linkerMemBase;
addDLL("msvcrt");
addDLL("kernel32");
#endif
+
+ IF_DEBUG(linker, debugBelch("initLinker: done\n"));
+ return;
+}
+
+void
+exitLinker( void ) {
+#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+ if (linker_init_done == 1) {
+ regfree(&re_invalid);
+ regfree(&re_realso);
+#ifdef THREADED_RTS
+ closeMutex(&dl_mutex);
+#endif
+ }
+#endif
}
/* -----------------------------------------------------------------------------
static OpenedDLL* opened_dlls = NULL;
#endif
-const char *
-addDLL( char *dll_name )
-{
# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
- /* ------------------- ELF DLL loader ------------------- */
+
+static const char *
+internal_dlopen(const char *dll_name)
+{
void *hdl;
const char *errmsg;
-
- initLinker();
+ char *errmsg_copy;
// omitted: RTLD_NOW
// see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
- hdl= dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
+ IF_DEBUG(linker,
+ debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name));
+
+ //-------------- Begin critical section ------------------
+ // This critical section is necessary because dlerror() is not
+ // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008)
+ // Also, the error message returned must be copied to preserve it
+ // (see POSIX also)
+ ACQUIRE_LOCK(&dl_mutex);
+ hdl = dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
+
+ errmsg = NULL;
if (hdl == NULL) {
/* dlopen failed; return a ptr to the error msg. */
errmsg = dlerror();
if (errmsg == NULL) errmsg = "addDLL: unknown error";
- return errmsg;
- } else {
+ errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL");
+ strcpy(errmsg_copy, errmsg);
+ errmsg = errmsg_copy;
+ }
+ RELEASE_LOCK(&dl_mutex);
+ //--------------- End critical section -------------------
+
+ return errmsg;
+}
+# endif
+
+const char *
+addDLL( char *dll_name )
+{
+# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+ /* ------------------- ELF DLL loader ------------------- */
+
+#define NMATCH 5
+ regmatch_t match[NMATCH];
+ const char *errmsg;
+ FILE* fp;
+ size_t match_length;
+#define MAXLINE 1000
+ char line[MAXLINE];
+ int result;
+
+ initLinker();
+
+ IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name));
+ errmsg = internal_dlopen(dll_name);
+
+ if (errmsg == NULL) {
return NULL;
}
- /*NOTREACHED*/
+
+ // GHC Trac ticket #2615
+ // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so)
+ // contain linker scripts rather than ELF-format object code. This
+ // code handles the situation by recognizing the real object code
+ // file name given in the linker script.
+ //
+ // If an "invalid ELF header" error occurs, it is assumed that the
+ // .so file contains a linker script instead of ELF object code.
+ // In this case, the code looks for the GROUP ( ... ) linker
+ // directive. If one is found, the first file name inside the
+ // parentheses is treated as the name of a dynamic library and the
+ // code attempts to dlopen that file. If this is also unsuccessful,
+ // an error message is returned.
+
+ // see if the error message is due to an invalid ELF header
+ IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg));
+ result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0);
+ IF_DEBUG(linker, debugBelch("result = %i\n", result));
+ if (result == 0) {
+ // success -- try to read the named file as a linker script
+ match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so),
+ MAXLINE-1);
+ strncpy(line, (errmsg+(match[1].rm_so)),match_length);
+ line[match_length] = '\0'; // make sure string is null-terminated
+ IF_DEBUG(linker, debugBelch ("file name = '%s'\n", line));
+ if ((fp = fopen(line, "r")) == NULL) {
+ return errmsg; // return original error if open fails
+ }
+ // try to find a GROUP ( ... ) command
+ while (fgets(line, MAXLINE, fp) != NULL) {
+ IF_DEBUG(linker, debugBelch("input line = %s", line));
+ if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
+ // success -- try to dlopen the first named file
+ IF_DEBUG(linker, debugBelch("match%s\n",""));
+ line[match[1].rm_eo] = '\0';
+ errmsg = internal_dlopen(line+match[1].rm_so);
+ break;
+ }
+ // if control reaches here, no GROUP ( ... ) directive was found
+ // and the original error message is returned to the caller
+ }
+ fclose(fp);
+ }
+ return errmsg;
# elif defined(OBJFORMAT_PEi386)
/* ------------------- Win32 DLL loader ------------------- */
lookupSymbol( char *lbl )
{
void *val;
+ IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl));
initLinker() ;
ASSERT(symhash != NULL);
val = lookupStrHashTable(symhash, lbl);
if (val == NULL) {
+ IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n"));
# if defined(OBJFORMAT_ELF)
return dlsym(dl_prog_handle, lbl);
# elif defined(OBJFORMAT_MACHO)
symbol name. For now, we simply strip it off here (and ONLY
here).
*/
+ IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n", lbl));
ASSERT(lbl[0] == '_');
return dlsym(dl_prog_handle, lbl+1);
# else
# elif defined(OBJFORMAT_PEi386)
void* sym;
- sym = lookupSymbolInDLLs(lbl);
+ sym = lookupSymbolInDLLs((unsigned char*)lbl);
if (sym != NULL) { return sym; };
// Also try looking up the symbol without the @N suffix. Some
// DLLs have the suffixes on their symbols, some don't.
- zapTrailingAtSign ( lbl );
- sym = lookupSymbolInDLLs(lbl);
+ zapTrailingAtSign ( (unsigned char*)lbl );
+ sym = lookupSymbolInDLLs((unsigned char*)lbl);
if (sym != NULL) { return sym; };
return NULL;
return NULL;
# endif
} else {
+ IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p\n", lbl, val));
return val;
}
}
pagesize = getpagesize();
size = ROUND_UP(bytes, pagesize);
-#if defined(x86_64_HOST_ARCH)
+#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
mmap_again:
if (mmap_32bit_base != 0) {
stg_exit(EXIT_FAILURE);
}
-#if defined(x86_64_HOST_ARCH)
+#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
if (mmap_32bit_base != 0) {
if (result == map_addr) {
mmap_32bit_base = (StgWord8*)map_addr + size;
}
#endif // USE_MMAP
+static ObjectCode*
+mkOc( char *path, char *image, int imageSize,
+ char *archiveMemberName
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ , int misalignment
+#endif
+#endif
+ ) {
+ ObjectCode* oc;
+
+ oc = stgMallocBytes(sizeof(ObjectCode), "loadArchive(oc)");
+
+# if defined(OBJFORMAT_ELF)
+ oc->formatName = "ELF";
+# elif defined(OBJFORMAT_PEi386)
+ oc->formatName = "PEi386";
+# elif defined(OBJFORMAT_MACHO)
+ oc->formatName = "Mach-O";
+# else
+ stgFree(oc);
+ barf("loadObj: not implemented on this platform");
+# endif
+
+ oc->image = image;
+ /* sigh, strdup() isn't a POSIX function, so do it the long way */
+ oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
+ strcpy(oc->fileName, path);
+
+ if (archiveMemberName) {
+ oc->archiveMemberName = stgMallocBytes( strlen(archiveMemberName)+1, "loadObj" );
+ strcpy(oc->archiveMemberName, archiveMemberName);
+ }
+ else {
+ oc->archiveMemberName = NULL;
+ }
+
+ oc->fileSize = imageSize;
+ oc->symbols = NULL;
+ oc->sections = NULL;
+ oc->proddables = NULL;
+
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ oc->misalignment = misalignment;
+#endif
+#endif
+
+ /* chain it onto the list of objects */
+ oc->next = objects;
+ objects = oc;
+
+ return oc;
+}
+
+HsInt
+loadArchive( char *path )
+{
+ ObjectCode* oc;
+ char *image;
+ int memberSize;
+ FILE *f;
+ int n;
+ size_t thisFileNameSize;
+ char *fileName;
+ size_t fileNameSize;
+ int isObject, isGnuIndex;
+ char tmp[12];
+ char *gnuFileIndex;
+ int gnuFileIndexSize;
+#if !defined(USE_MMAP) && defined(darwin_HOST_OS)
+ int misalignment;
+#endif
+
+ IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%s'\n", path));
+
+ gnuFileIndex = NULL;
+ gnuFileIndexSize = 0;
+
+ fileNameSize = 32;
+ fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)");
+
+ f = fopen(path, "rb");
+ if (!f)
+ barf("loadObj: can't read `%s'", path);
+
+ n = fread ( tmp, 1, 8, f );
+ if (strncmp(tmp, "!<arch>\n", 8) != 0)
+ barf("loadArchive: Not an archive: `%s'", path);
+
+ while(1) {
+ n = fread ( fileName, 1, 16, f );
+ if (n != 16) {
+ if (feof(f)) {
+ break;
+ }
+ else {
+ barf("loadArchive: Failed reading file name from `%s'", path);
+ }
+ }
+ n = fread ( tmp, 1, 12, f );
+ if (n != 12)
+ barf("loadArchive: Failed reading mod time from `%s'", path);
+ n = fread ( tmp, 1, 6, f );
+ if (n != 6)
+ barf("loadArchive: Failed reading owner from `%s'", path);
+ n = fread ( tmp, 1, 6, f );
+ if (n != 6)
+ barf("loadArchive: Failed reading group from `%s'", path);
+ n = fread ( tmp, 1, 8, f );
+ if (n != 8)
+ barf("loadArchive: Failed reading mode from `%s'", path);
+ n = fread ( tmp, 1, 10, f );
+ if (n != 10)
+ barf("loadArchive: Failed reading size from `%s'", path);
+ tmp[10] = '\0';
+ for (n = 0; isdigit(tmp[n]); n++);
+ tmp[n] = '\0';
+ memberSize = atoi(tmp);
+ n = fread ( tmp, 1, 2, f );
+ if (strncmp(tmp, "\x60\x0A", 2) != 0)
+ barf("loadArchive: Failed reading magic from `%s' at %ld. Got %c%c",
+ path, ftell(f), tmp[0], tmp[1]);
+
+ isGnuIndex = 0;
+ /* Check for BSD-variant large filenames */
+ if (0 == strncmp(fileName, "#1/", 3)) {
+ fileName[16] = '\0';
+ if (isdigit(fileName[3])) {
+ for (n = 4; isdigit(fileName[n]); n++);
+ fileName[n] = '\0';
+ thisFileNameSize = atoi(fileName + 3);
+ memberSize -= thisFileNameSize;
+ if (thisFileNameSize >= fileNameSize) {
+ /* Double it to avoid potentially continually
+ increasing it by 1 */
+ fileNameSize = thisFileNameSize * 2;
+ fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
+ }
+ n = fread ( fileName, 1, thisFileNameSize, f );
+ if (n != (int)thisFileNameSize) {
+ barf("loadArchive: Failed reading filename from `%s'",
+ path);
+ }
+ fileName[thisFileNameSize] = 0;
+ }
+ else {
+ barf("loadArchive: BSD-variant filename size not found while reading filename from `%s'", path);
+ }
+ }
+ /* Check for GNU file index file */
+ else if (0 == strncmp(fileName, "//", 2)) {
+ fileName[0] = '\0';
+ thisFileNameSize = 0;
+ isGnuIndex = 1;
+ }
+ /* Check for a file in the GNU file index */
+ else if (fileName[0] == '/') {
+ if (isdigit(fileName[1])) {
+ int i;
+
+ for (n = 2; isdigit(fileName[n]); n++);
+ fileName[n] = '\0';
+ n = atoi(fileName + 1);
+
+ if (gnuFileIndex == NULL) {
+ barf("loadArchive: GNU-variant filename without an index while reading from `%s'", path);
+ }
+ if (n < 0 || n > gnuFileIndexSize) {
+ barf("loadArchive: GNU-variant filename offset %d out of range [0..%d] while reading filename from `%s'", n, gnuFileIndexSize, path);
+ }
+ if (n != 0 && gnuFileIndex[n - 1] != '\n') {
+ barf("loadArchive: GNU-variant filename offset %d invalid (range [0..%d]) while reading filename from `%s'", n, gnuFileIndexSize, path);
+ }
+ for (i = n; gnuFileIndex[i] != '/'; i++);
+ thisFileNameSize = i - n;
+ if (thisFileNameSize >= fileNameSize) {
+ /* Double it to avoid potentially continually
+ increasing it by 1 */
+ fileNameSize = thisFileNameSize * 2;
+ fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
+ }
+ memcpy(fileName, gnuFileIndex + n, thisFileNameSize);
+ fileName[thisFileNameSize] = '\0';
+ }
+ else if (fileName[1] == ' ') {
+ fileName[0] = '\0';
+ thisFileNameSize = 0;
+ }
+ else {
+ barf("loadArchive: GNU-variant filename offset not found while reading filename from `%s'", path);
+ }
+ }
+ /* Finally, the case where the filename field actually contains
+ the filename */
+ else {
+ /* GNU ar terminates filenames with a '/', this allowing
+ spaces in filenames. So first look to see if there is a
+ terminating '/'. */
+ for (thisFileNameSize = 0;
+ thisFileNameSize < 16;
+ thisFileNameSize++) {
+ if (fileName[thisFileNameSize] == '/') {
+ fileName[thisFileNameSize] = '\0';
+ break;
+ }
+ }
+ /* If we didn't find a '/', then a space teminates the
+ filename. Note that if we don't find one, then
+ thisFileNameSize ends up as 16, and we already have the
+ '\0' at the end. */
+ if (thisFileNameSize == 16) {
+ for (thisFileNameSize = 0;
+ thisFileNameSize < 16;
+ thisFileNameSize++) {
+ if (fileName[thisFileNameSize] == ' ') {
+ fileName[thisFileNameSize] = '\0';
+ break;
+ }
+ }
+ }
+ }
+
+ IF_DEBUG(linker,
+ debugBelch("loadArchive: Found member file `%s'\n", fileName));
+
+ isObject = thisFileNameSize >= 2
+ && fileName[thisFileNameSize - 2] == '.'
+ && fileName[thisFileNameSize - 1] == 'o';
+
+ if (isObject) {
+ char *archiveMemberName;
+
+ IF_DEBUG(linker, debugBelch("loadArchive: Member is an object file...loading...\n"));
+
+ /* We can't mmap from the archive directly, as object
+ files need to be 8-byte aligned but files in .ar
+ archives are 2-byte aligned. When possible we use mmap
+ to get some anonymous memory, as on 64-bit platforms if
+ we use malloc then we can be given memory above 2^32.
+ In the mmap case we're probably wasting lots of space;
+ we could do better. */
+#if defined(USE_MMAP)
+ image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1);
+#elif defined(darwin_HOST_OS)
+ /* See loadObj() */
+ misalignment = machoGetMisalignment(f);
+ image = stgMallocBytes(memberSize + misalignment, "loadArchive(image)");
+ image += misalignment;
+#else
+ image = stgMallocBytes(memberSize, "loadArchive(image)");
+#endif
+ n = fread ( image, 1, memberSize, f );
+ if (n != memberSize) {
+ barf("loadArchive: error whilst reading `%s'", path);
+ }
+
+ archiveMemberName = stgMallocBytes(strlen(path) + thisFileNameSize + 3,
+ "loadArchive(file)");
+ sprintf(archiveMemberName, "%s(%.*s)",
+ path, (int)thisFileNameSize, fileName);
+
+ oc = mkOc(path, image, memberSize, archiveMemberName
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ , misalignment
+#endif
+#endif
+ );
+
+ stgFree(archiveMemberName);
+
+ if (0 == loadOc(oc)) {
+ stgFree(fileName);
+ return 0;
+ }
+ }
+ else if (isGnuIndex) {
+ if (gnuFileIndex != NULL) {
+ barf("loadArchive: GNU-variant index found, but already have an index, while reading filename from `%s'", path);
+ }
+ IF_DEBUG(linker, debugBelch("loadArchive: Found GNU-variant file index\n"));
+#ifdef USE_MMAP
+ gnuFileIndex = mmapForLinker(memberSize + 1, MAP_ANONYMOUS, -1);
+#else
+ gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)");
+#endif
+ n = fread ( gnuFileIndex, 1, memberSize, f );
+ if (n != memberSize) {
+ barf("loadArchive: error whilst reading `%s'", path);
+ }
+ gnuFileIndex[memberSize] = '/';
+ gnuFileIndexSize = memberSize;
+ }
+ else {
+ n = fseek(f, memberSize, SEEK_CUR);
+ if (n != 0)
+ barf("loadArchive: error whilst seeking by %d in `%s'",
+ memberSize, path);
+ }
+ /* .ar files are 2-byte aligned */
+ if (memberSize % 2) {
+ n = fread ( tmp, 1, 1, f );
+ if (n != 1) {
+ if (feof(f)) {
+ break;
+ }
+ else {
+ barf("loadArchive: Failed reading padding from `%s'", path);
+ }
+ }
+ }
+ }
+
+ fclose(f);
+
+ stgFree(fileName);
+ if (gnuFileIndex != NULL) {
+#ifdef USE_MMAP
+ munmap(gnuFileIndex, gnuFileIndexSize + 1);
+#else
+ stgFree(gnuFileIndex);
+#endif
+ }
+
+ return 1;
+}
+
/* -----------------------------------------------------------------------------
* Load an obj (populate the global symbol table, but don't resolve yet)
*
loadObj( char *path )
{
ObjectCode* oc;
+ char *image;
+ int fileSize;
struct stat st;
int r;
#ifdef USE_MMAP
int fd;
#else
FILE *f;
+# if defined(darwin_HOST_OS)
+ int misalignment;
+# endif
#endif
+ IF_DEBUG(linker, debugBelch("loadObj %s\n", path));
+
initLinker();
/* debugBelch("loadObj %s\n", path ); */
}
}
- oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
-
-# if defined(OBJFORMAT_ELF)
- oc->formatName = "ELF";
-# elif defined(OBJFORMAT_PEi386)
- oc->formatName = "PEi386";
-# elif defined(OBJFORMAT_MACHO)
- oc->formatName = "Mach-O";
-# else
- stgFree(oc);
- barf("loadObj: not implemented on this platform");
-# endif
-
r = stat(path, &st);
- if (r == -1) { return 0; }
-
- /* sigh, strdup() isn't a POSIX function, so do it the long way */
- oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
- strcpy(oc->fileName, path);
-
- oc->fileSize = st.st_size;
- oc->symbols = NULL;
- oc->sections = NULL;
- oc->proddables = NULL;
+ if (r == -1) {
+ IF_DEBUG(linker, debugBelch("File doesn't exist\n"));
+ return 0;
+ }
- /* chain it onto the list of objects */
- oc->next = objects;
- objects = oc;
+ fileSize = st.st_size;
#ifdef USE_MMAP
/* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
if (fd == -1)
barf("loadObj: can't open `%s'", path);
- oc->image = mmapForLinker(oc->fileSize, 0, fd);
+ image = mmapForLinker(fileSize, 0, fd);
close(fd);
# if defined(mingw32_HOST_OS)
// TODO: We would like to use allocateExec here, but allocateExec
// cannot currently allocate blocks large enough.
- oc->image = VirtualAlloc(NULL, oc->fileSize, MEM_RESERVE | MEM_COMMIT,
+ image = VirtualAlloc(NULL, fileSize, MEM_RESERVE | MEM_COMMIT,
PAGE_EXECUTE_READWRITE);
# elif defined(darwin_HOST_OS)
// In a Mach-O .o file, all sections can and will be misaligned
// as SSE (used by gcc for floating point) and Altivec require
// 16-byte alignment.
// We calculate the correct alignment from the header before
- // reading the file, and then we misalign oc->image on purpose so
+ // reading the file, and then we misalign image on purpose so
// that the actual sections end up aligned again.
- oc->misalignment = machoGetMisalignment(f);
- oc->image = stgMallocBytes(oc->fileSize + oc->misalignment, "loadObj(image)");
- oc->image += oc->misalignment;
+ misalignment = machoGetMisalignment(f);
+ image = stgMallocBytes(fileSize + misalignment, "loadObj(image)");
+ image += misalignment;
# else
- oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
+ image = stgMallocBytes(fileSize, "loadObj(image)");
# endif
{
int n;
- n = fread ( oc->image, 1, oc->fileSize, f );
- if (n != oc->fileSize)
+ n = fread ( image, 1, fileSize, f );
+ if (n != fileSize)
barf("loadObj: error whilst reading `%s'", path);
}
fclose(f);
#endif /* USE_MMAP */
+ oc = mkOc(path, image, fileSize, NULL
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ , misalignment
+#endif
+#endif
+ );
+
+ return loadOc(oc);
+}
+
+static HsInt
+loadOc( ObjectCode* oc ) {
+ int r;
+
+ IF_DEBUG(linker, debugBelch("loadOc\n"));
+
# if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
r = ocAllocateSymbolExtras_MachO ( oc );
- if (!r) { return r; }
+ if (!r) {
+ IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO failed\n"));
+ return r;
+ }
# elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
r = ocAllocateSymbolExtras_ELF ( oc );
- if (!r) { return r; }
+ if (!r) {
+ IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_ELF failed\n"));
+ return r;
+ }
#endif
/* verify the in-memory image */
# else
barf("loadObj: no verify method");
# endif
- if (!r) { return r; }
+ if (!r) {
+ IF_DEBUG(linker, debugBelch("ocVerifyImage_* failed\n"));
+ return r;
+ }
/* build the symbol list for this image */
# if defined(OBJFORMAT_ELF)
# else
barf("loadObj: no getNames method");
# endif
- if (!r) { return r; }
+ if (!r) {
+ IF_DEBUG(linker, debugBelch("ocGetNames_* failed\n"));
+ return r;
+ }
/* loaded, but not resolved yet */
oc->status = OBJECT_LOADED;
+ IF_DEBUG(linker, debugBelch("loadObj done.\n"));
return 1;
}
ObjectCode *oc;
int r;
+ IF_DEBUG(linker, debugBelch("resolveObjs: start\n"));
initLinker();
for (oc = objects; oc; oc = oc->next) {
oc->status = OBJECT_RESOLVED;
}
}
+ IF_DEBUG(linker, debugBelch("resolveObjs: done\n"));
return 1;
}
unloadObj( char *path )
{
ObjectCode *oc, *prev;
+ HsBool unloadedAnyObj = HS_BOOL_FALSE;
ASSERT(symhash != NULL);
ASSERT(objects != NULL);
stgFree(oc->symbols);
stgFree(oc->sections);
stgFree(oc);
- return 1;
+
+ /* This could be a member of an archive so continue
+ * unloading other members. */
+ unloadedAnyObj = HS_BOOL_TRUE;
}
}
- errorBelch("unloadObj: can't find `%s' to unload", path);
- return 0;
+ if (unloadedAnyObj) {
+ return 1;
+ }
+ else {
+ errorBelch("unloadObj: can't find `%s' to unload", path);
+ return 0;
+ }
}
/* -----------------------------------------------------------------------------
{
ProddableBlock* pb
= stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
- /* debugBelch("aPB %p %p %d\n", oc, start, size); */
+ IF_DEBUG(linker, debugBelch("addProddableBlock %p %p %d\n", oc, start, size));
ASSERT(size > 0);
pb->start = start;
pb->size = size;
* PowerPC specifics (instruction cache flushing)
* ------------------------------------------------------------------------*/
-#ifdef powerpc_TARGET_ARCH
+#ifdef powerpc_HOST_ARCH
/*
ocFlushInstructionCache
Because the PPC has split data/instruction caches, we have to
do that whenever we modify code at runtime.
*/
-
-static void ocFlushInstructionCache( ObjectCode *oc )
+static void ocFlushInstructionCacheFrom(void* begin, size_t length)
{
- int n = (oc->fileSize + sizeof( SymbolExtra ) * oc->n_symbol_extras + 3) / 4;
- unsigned long *p = (unsigned long *) oc->image;
+ size_t n = (length + 3) / 4;
+ unsigned long* p = begin;
- while( n-- )
+ while (n--)
{
__asm__ volatile ( "dcbf 0,%0\n\t"
"sync\n\t"
"isync"
);
}
+static void ocFlushInstructionCache( ObjectCode *oc )
+{
+ /* The main object code */
+ ocFlushInstructionCacheFrom(oc->image + oc->misalignment, oc->fileSize);
+
+ /* Jump Islands */
+ ocFlushInstructionCacheFrom(oc->symbol_extras, sizeof(SymbolExtra) * oc->n_symbol_extras);
+}
#endif
/* --------------------------------------------------------------------------
{
if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
UInt32 strtab_offset = * (UInt32*)(name+4);
- strncpy ( dst, strtab+strtab_offset, dstSize );
+ strncpy ( (char*)dst, (char*)strtab+strtab_offset, dstSize );
dst[dstSize-1] = 0;
} else {
int i = 0;
*/
if (name[7]==0) return name;
/* The annoying case: 8 bytes. Copy into a temporary
- (which is never freed ...)
+ (XXX which is never freed ...)
*/
newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
ASSERT(newstr);
- strncpy(newstr,name,8);
+ strncpy((char*)newstr,(char*)name,8);
newstr[8] = 0;
return newstr;
}
+/* Getting the name of a section is mildly tricky, so we make a
+ function for it. Sadly, in one case we have to copy the string
+ (when it is exactly 8 bytes long there's no trailing '\0'), so for
+ consistency we *always* copy the string; the caller must free it
+*/
+static char *
+cstring_from_section_name (UChar* name, UChar* strtab)
+{
+ char *newstr;
+
+ if (name[0]=='/') {
+ int strtab_offset = strtol((char*)name+1,NULL,10);
+ int len = strlen(((char*)strtab) + strtab_offset);
+
+ newstr = stgMallocBytes(len, "cstring_from_section_symbol_name");
+ strcpy((char*)newstr, (char*)((UChar*)strtab) + strtab_offset);
+ return newstr;
+ }
+ else
+ {
+ newstr = stgMallocBytes(9, "cstring_from_section_symbol_name");
+ ASSERT(newstr);
+ strncpy((char*)newstr,(char*)name,8);
+ newstr[8] = 0;
+ return newstr;
+ }
+}
/* Just compares the short names (first 8 chars) */
static COFF_section *
-findPEi386SectionCalled ( ObjectCode* oc, char* name )
+findPEi386SectionCalled ( ObjectCode* oc, UChar* name )
{
int i;
COFF_header* hdr
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));
+ sym = GetProcAddress(o_dll->instance, (char*)(lbl+1));
if (sym != NULL) {
/*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
return sym;
}
}
- sym = GetProcAddress(o_dll->instance, lbl);
+ sym = GetProcAddress(o_dll->instance, (char*)lbl);
if (sym != NULL) {
/*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
return sym;
COFF_section* sectab_i
= (COFF_section*)
myindex ( sizeof_COFF_section, sectab, i );
- if (0 != strcmp(sectab_i->Name, ".bss")) continue;
+
+ char *secname = cstring_from_section_name(sectab_i->Name, strtab);
+
+ if (0 != strcmp(secname, ".bss")) {
+ stgFree(secname);
+ continue;
+ }
+
+ stgFree(secname);
+
/* sof 10/05: the PE spec text isn't too clear regarding what
* the SizeOfRawData field is supposed to hold for object
* file sections containing just uninitialized data -- for executables,
COFF_section* sectab_i
= (COFF_section*)
myindex ( sizeof_COFF_section, sectab, i );
- IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
+
+ char *secname = cstring_from_section_name(sectab_i->Name, strtab);
+
+ IF_DEBUG(linker, debugBelch("section name = %s\n", secname ));
# if 0
/* I'm sure this is the Right Way to do it. However, the
kind = SECTIONKIND_CODE_OR_RODATA;
# endif
- if (0==strcmp(".text",sectab_i->Name) ||
- 0==strcmp(".rdata",sectab_i->Name)||
- 0==strcmp(".rodata",sectab_i->Name))
+ if (0==strcmp(".text",(char*)secname) ||
+ 0==strcmp(".rdata",(char*)secname)||
+ 0==strcmp(".rodata",(char*)secname))
kind = SECTIONKIND_CODE_OR_RODATA;
- if (0==strcmp(".data",sectab_i->Name) ||
- 0==strcmp(".bss",sectab_i->Name))
+ if (0==strcmp(".data",(char*)secname) ||
+ 0==strcmp(".bss",(char*)secname))
kind = SECTIONKIND_RWDATA;
ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
if (kind == SECTIONKIND_OTHER
/* Ignore sections called which contain stabs debugging
information. */
- && 0 != strcmp(".stab", sectab_i->Name)
- && 0 != strcmp(".stabstr", sectab_i->Name)
+ && 0 != strcmp(".stab", (char*)secname)
+ && 0 != strcmp(".stabstr", (char*)secname)
/* ignore constructor section for now */
- && 0 != strcmp(".ctors", sectab_i->Name)
+ && 0 != strcmp(".ctors", (char*)secname)
/* ignore section generated from .ident */
- && 0!= strcmp("/4", sectab_i->Name)
+ && 0!= strncmp(".debug", (char*)secname, 6)
/* ignore unknown section that appeared in gcc 3.4.5(?) */
- && 0!= strcmp(".reloc", sectab_i->Name)
+ && 0!= strcmp(".reloc", (char*)secname)
+ && 0 != strcmp(".rdata$zzz", (char*)secname)
) {
- errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
+ errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", secname, oc->fileName);
+ stgFree(secname);
return 0;
}
addSection(oc, kind, start, end);
addProddableBlock(oc, start, end - start + 1);
}
+
+ stgFree(secname);
}
/* Copy exported symbols into the ObjectCode. */
IF_DEBUG(linker, debugBelch("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);
+ oc->symbols[i] = (char*)sname;
+ ghciInsertStrHashTable(oc->fileName, symhash, (char*)sname, addr);
} else {
# if 0
debugBelch(
/* ToDo: should be variable-sized? But is at least safe in the
sense of buffer-overrun-proof. */
- char symbol[1000];
+ UChar symbol[1000];
/* debugBelch("resolving for %s\n", oc->fileName); */
hdr = (COFF_header*)(oc->image);
((UChar*)(oc->image)) + sectab_i->PointerToRelocations
);
+ char *secname = cstring_from_section_name(sectab_i->Name, strtab);
+
/* Ignore sections called which contain stabs debugging
information. */
- if (0 == strcmp(".stab", sectab_i->Name)
- || 0 == strcmp(".stabstr", sectab_i->Name)
- || 0 == strcmp(".ctors", sectab_i->Name))
- continue;
+ if (0 == strcmp(".stab", (char*)secname)
+ || 0 == strcmp(".stabstr", (char*)secname)
+ || 0 == strcmp(".ctors", (char*)secname)
+ || 0 == strncmp(".debug", (char*)secname, 6)
+ || 0 == strcmp(".rdata$zzz", (char*)secname)) {
+ stgFree(secname);
+ continue;
+ }
+
+ stgFree(secname);
if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
/* If the relocation field (a short) has overflowed, the
+ sym->Value);
} else {
copyName ( sym->Name, strtab, symbol, 1000-1 );
- S = (UInt32) lookupSymbol( symbol );
+ S = (UInt32) lookupSymbol( (char*)symbol );
if ((void*)S != NULL) goto foundit;
errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
return 0;
#define Elf_Sym Elf64_Sym
#define Elf_Rel Elf64_Rel
#define Elf_Rela Elf64_Rela
+#ifndef ELF_ST_TYPE
#define ELF_ST_TYPE ELF64_ST_TYPE
+#endif
+#ifndef ELF_ST_BIND
#define ELF_ST_BIND ELF64_ST_BIND
+#endif
+#ifndef ELF_R_TYPE
#define ELF_R_TYPE ELF64_R_TYPE
+#endif
+#ifndef ELF_R_SYM
#define ELF_R_SYM ELF64_R_SYM
+#endif
#else
#define ELFCLASS ELFCLASS32
#define Elf_Addr Elf32_Addr
case R_X86_64_PC32:
{
+#if defined(ALWAYS_PIC)
+ barf("R_X86_64_PC32 relocation, but ALWAYS_PIC.");
+#else
StgInt64 off = value - P;
if (off >= 0x7fffffffL || off < -0x80000000L) {
#if X86_64_ELF_NONPIC_HACK
#endif
}
*(Elf64_Word *)P = (Elf64_Word)off;
+#endif
break;
}
}
case R_X86_64_32:
+#if defined(ALWAYS_PIC)
+ barf("R_X86_64_32 relocation, but ALWAYS_PIC.");
+#else
if (value >= 0x7fffffffL) {
#if X86_64_ELF_NONPIC_HACK
StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
#endif
}
*(Elf64_Word *)P = (Elf64_Word)value;
+#endif
break;
case R_X86_64_32S:
+#if defined(ALWAYS_PIC)
+ barf("R_X86_64_32S relocation, but ALWAYS_PIC.");
+#else
if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
#if X86_64_ELF_NONPIC_HACK
StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
#endif
}
*(Elf64_Sword *)P = (Elf64_Sword)value;
+#endif
break;
case R_X86_64_GOTPCREL:
case R_X86_64_PLT32:
{
+#if defined(ALWAYS_PIC)
+ barf("R_X86_64_PLT32 relocation, but ALWAYS_PIC.");
+#else
StgInt64 off = value - P;
if (off >= 0x7fffffffL || off < -0x80000000L) {
StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
off = pltAddress + A - P;
}
*(Elf64_Word *)P = (Elf64_Word)off;
+#endif
break;
}
#endif
char *image = (char*) oc->image;
struct mach_header *header = (struct mach_header*) image;
-#if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
- if(header->magic != MH_MAGIC_64)
+#if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
+ if(header->magic != MH_MAGIC_64) {
+ errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
+ oc->fileName, MH_MAGIC_64, header->magic);
return 0;
+ }
#else
- if(header->magic != MH_MAGIC)
+ if(header->magic != MH_MAGIC) {
+ errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
+ oc->fileName, MH_MAGIC, header->magic);
return 0;
+ }
#endif
// FIXME: do some more verifying here
return 1;
unsigned i;
size_t itemSize = 4;
+ IF_DEBUG(linker, debugBelch("resolveImports: start\n"));
+
#if i386_HOST_ARCH
int isJumpTable = 0;
if(!strcmp(sect->sectname,"__jump_table"))
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))
+ IF_DEBUG(linker, debugBelch("resolveImports: resolving %s\n", nm));
+ if ((symbol->n_type & N_TYPE) == N_UNDF
+ && (symbol->n_type & N_EXT) && (symbol->n_value != 0)) {
addr = (void*) (symbol->n_value);
- else
+ IF_DEBUG(linker, debugBelch("resolveImports: undefined external %s has value %p\n", nm, addr));
+ } else {
addr = lookupSymbol(nm);
- if(!addr)
+ IF_DEBUG(linker, debugBelch("resolveImports: looking up %s, %p\n", nm, addr));
+ }
+ if (!addr)
{
errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
return 0;
}
}
+ IF_DEBUG(linker, debugBelch("resolveImports: done\n"));
return 1;
}
unsigned long address)
{
int i;
- for(i = 0; i < nSections; i++)
+ IF_DEBUG(linker, debugBelch("relocateAddress: start\n"));
+ for (i = 0; i < nSections; i++)
{
- if(sections[i].addr <= address
+ IF_DEBUG(linker, debugBelch(" relocating address in section %d\n", i));
+ if (sections[i].addr <= address
&& address < sections[i].addr + sections[i].size)
{
return (unsigned long)oc->image
int nSections, struct section* sections, struct section *sect)
{
struct relocation_info *relocs;
- int i,n;
+ int i, n;
+
+ IF_DEBUG(linker, debugBelch("relocateSection: start\n"));
if(!strcmp(sect->sectname,"__la_symbol_ptr"))
return 1;
return 1;
n = sect->nreloc;
+ IF_DEBUG(linker, debugBelch("relocateSection: number of relocations: %d\n", n));
+
relocs = (struct relocation_info*) (image + sect->reloff);
for(i=0;i<n;i++)
default:
barf("Unknown size.");
}
-
- if(type == X86_64_RELOC_GOT
+
+ IF_DEBUG(linker,
+ debugBelch("relocateSection: length = %d, thing = %d, baseValue = %p\n",
+ reloc->r_length, thing, baseValue));
+
+ if (type == X86_64_RELOC_GOT
|| type == X86_64_RELOC_GOT_LOAD)
{
+ struct nlist *symbol = &nlist[reloc->r_symbolnum];
+ char *nm = image + symLC->stroff + symbol->n_un.n_strx;
+
+ IF_DEBUG(linker, debugBelch("relocateSection: making jump island for %s, extern = %d, X86_64_RELOC_GOT\n", nm, reloc->r_extern));
ASSERT(reloc->r_extern);
- value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)->addr;
+ value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, (unsigned long)lookupSymbol(nm))->addr;
type = X86_64_RELOC_SIGNED;
}
{
struct nlist *symbol = &nlist[reloc->r_symbolnum];
char *nm = image + symLC->stroff + symbol->n_un.n_strx;
- if(symbol->n_value == 0)
- value = (uint64_t) lookupSymbol(nm);
- else
+
+ IF_DEBUG(linker, debugBelch("relocateSection: looking up external symbol %s\n", nm));
+ IF_DEBUG(linker, debugBelch(" : type = %d\n", symbol->n_type));
+ IF_DEBUG(linker, debugBelch(" : sect = %d\n", symbol->n_sect));
+ IF_DEBUG(linker, debugBelch(" : desc = %d\n", symbol->n_desc));
+ IF_DEBUG(linker, debugBelch(" : value = %d\n", symbol->n_value));
+ if ((symbol->n_type & N_TYPE) == N_SECT) {
value = relocateAddress(oc, nSections, sections,
symbol->n_value);
+ IF_DEBUG(linker, debugBelch("relocateSection, defined external symbol %s, relocated address %p\n", nm, value));
+ }
+ else {
+ value = (uint64_t) lookupSymbol(nm);
+ IF_DEBUG(linker, debugBelch("relocateSection: external symbol %s, address %p\n", nm, value));
+ }
}
else
{
- sections[reloc->r_symbolnum-1].addr
+ (uint64_t) image;
}
-
- if(type == X86_64_RELOC_BRANCH)
+
+ IF_DEBUG(linker, debugBelch("relocateSection: value = %p\n", value));
+
+ if (type == X86_64_RELOC_BRANCH)
{
if((int32_t)(value - baseValue) != (int64_t)(value - baseValue))
{
thing += value;
break;
case X86_64_RELOC_SIGNED:
+ case X86_64_RELOC_SIGNED_1:
+ case X86_64_RELOC_SIGNED_2:
+ case X86_64_RELOC_SIGNED_4:
ASSERT(reloc->r_pcrel);
thing += value - baseValue;
break;
else if(scat->r_type == PPC_RELOC_SECTDIFF
|| scat->r_type == PPC_RELOC_LO16_SECTDIFF
|| scat->r_type == PPC_RELOC_HI16_SECTDIFF
- || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
+ || scat->r_type == PPC_RELOC_HA16_SECTDIFF
+ || scat->r_type == PPC_RELOC_LOCAL_SECTDIFF)
#else
else if(scat->r_type == GENERIC_RELOC_SECTDIFF
|| scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
i++;
}
#endif
- else
+ else
{
barf ("Don't know how to handle this Mach-O "
"scattered relocation entry: "
"object file %s; entry type %ld; "
"address %#lx\n",
- oc->fileName, scat->r_type, scat->r_address);
+ OC_INFORMATIVE_FILENAME(oc),
+ scat->r_type,
+ scat->r_address);
return 0;
}
-
+
#ifdef powerpc_HOST_ARCH
if(scat->r_type == GENERIC_RELOC_VANILLA
|| scat->r_type == PPC_RELOC_SECTDIFF)
"with this r_length tag: "
"object file %s; entry type %ld; "
"r_length tag %ld; address %#lx\n",
- oc->fileName, scat->r_type, scat->r_length,
+ OC_INFORMATIVE_FILENAME(oc),
+ scat->r_type,
+ scat->r_length,
scat->r_address);
return 0;
}
barf("Don't know how to handle *PC-relative* Mach-O "
"scattered relocation entry: "
"object file %s; entry type %ld; address %#lx\n",
- oc->fileName, scat->r_type, scat->r_address);
+ OC_INFORMATIVE_FILENAME(oc),
+ scat->r_type,
+ scat->r_address);
return 0;
- }
-
+ }
+
}
else /* !(relocs[i].r_address & R_SCATTERED) */
{
{
barf("Can't handle this Mach-O relocation entry "
"(not scattered): "
- "object file %s; entry type %ld; address %#lx\n",
- oc->fileName, reloc->r_type, reloc->r_address);
+ "object file %s; entry type %ld; address %#lx\n",
+ OC_INFORMATIVE_FILENAME(oc),
+ reloc->r_type,
+ reloc->r_address);
return 0;
}
}
else if(reloc->r_type == PPC_RELOC_BR24)
{
- if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
+ if((word & 0x03) != 0)
+ barf("%s: unconditional relative branch with a displacement "
+ "which isn't a multiple of 4 bytes: %#lx",
+ OC_INFORMATIVE_FILENAME(oc),
+ word);
+
+ if((word & 0xFE000000) != 0xFE000000 &&
+ (word & 0xFE000000) != 0x00000000)
{
// The branch offset is too large.
// Therefore, we try to use a jump island.
if(jumpIsland == 0)
{
- barf("unconditional relative branch out of range: "
- "no jump island available");
+ barf("%s: unconditional relative branch out of range: "
+ "no jump island available: %#lx",
+ OC_INFORMATIVE_FILENAME(oc),
+ word);
}
word = offsetToJumpIsland;
- if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
- barf("unconditional relative branch out of range: "
- "jump island out of range");
+ if((word & 0xFE000000) != 0xFE000000 &&
+ (word & 0xFE000000) != 0x00000000)
+ barf("%s: unconditional relative branch out of range: "
+ "jump island out of range: %#lx",
+ OC_INFORMATIVE_FILENAME(oc),
+ word);
}
*wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
continue;
barf("Can't handle Mach-O relocation entry (not scattered) "
"with this r_length tag: "
"object file %s; entry type %ld; "
- "r_length tag %ld; address %#lx\n",
- oc->fileName, reloc->r_type, reloc->r_length,
+ "r_length tag %ld; address %#lx\n",
+ OC_INFORMATIVE_FILENAME(oc),
+ reloc->r_type,
+ reloc->r_length,
reloc->r_address);
return 0;
}
}
#endif
}
+ IF_DEBUG(linker, debugBelch("relocateSection: done\n"));
return 1;
}
char *commonStorage = NULL;
unsigned long commonCounter;
+ IF_DEBUG(linker,debugBelch("ocGetNames_MachO: start\n"));
+
for(i=0;i<header->ncmds;i++)
{
if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
for(i=0;i<segLC->nsects;i++)
{
- if(sections[i].size == 0)
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: segment %d\n", i));
+ if (sections[i].size == 0)
continue;
if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
}
}
}
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: %d external symbols\n", oc->n_symbols));
oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
"ocGetNames_MachO(oc->symbols)");
if(nlist[i].n_type & N_EXT)
{
char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
- if((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm))
- ; // weak definition, and we already have a definition
+ if ((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm)) {
+ // weak definition, and we already have a definition
+ IF_DEBUG(linker, debugBelch(" weak: %s\n", nm));
+ }
else
{
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting %s\n", nm));
ghciInsertStrHashTable(oc->fileName, symhash, nm,
image
+ sections[nlist[i].n_sect-1].offset
nlist[i].n_value = commonCounter;
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting common symbol: %s\n", nm));
ghciInsertStrHashTable(oc->fileName, symhash, nm,
(void*)commonCounter);
oc->symbols[curSymbol++] = nm;
struct dysymtab_command *dsymLC = NULL;
struct nlist *nlist;
- for(i=0;i<header->ncmds;i++)
+ IF_DEBUG(linker, debugBelch("ocResolve_MachO: start\n"));
+ for (i = 0; i < header->ncmds; i++)
{
if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
segLC = (struct segment_command*) lc;
unsigned long *indirectSyms
= (unsigned long*) (image + dsymLC->indirectsymoff);
- for(i=0;i<segLC->nsects;i++)
+ IF_DEBUG(linker, debugBelch("ocResolve_MachO: resolving dsymLC\n"));
+ for (i = 0; i < segLC->nsects; i++)
{
if( !strcmp(sections[i].sectname,"__la_symbol_ptr")
|| !strcmp(sections[i].sectname,"__la_sym_ptr2")
if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
return 0;
}
+ else
+ {
+ IF_DEBUG(linker, debugBelch("ocResolve_MachO: unknown section\n"));
+ }
}
}
for(i=0;i<segLC->nsects;i++)
{
- if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
+ IF_DEBUG(linker, debugBelch("ocResolve_MachO: relocating section %d\n", i));
+
+ if (!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
return 0;
}
* Yuck.
*/
+extern void* symbolsWithoutUnderscore[];
+
static void machoInitSymbolsWithoutUnderscore()
{
- extern void* symbolsWithoutUnderscore[];
void **p = symbolsWithoutUnderscore;
__asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
}
#endif
+#ifndef USE_MMAP
/*
* Figure out by how much to shift the entire Mach-O file in memory
* when loading so that its single segment ends up 16-byte-aligned
{
struct mach_header header;
int misalignment;
-
- fread(&header, sizeof(header), 1, f);
- rewind(f);
-#if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
- if(header.magic != MH_MAGIC_64)
- return 0;
+ {
+ int n = fread(&header, sizeof(header), 1, f);
+ if (n != 1) {
+ barf("machoGetMisalignment: can't read the Mach-O header");
+ }
+ }
+ fseek(f, -sizeof(header), SEEK_CUR);
+
+#if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
+ if(header.magic != MH_MAGIC_64) {
+ barf("Bad magic. Expected: %08x, got: %08x.",
+ MH_MAGIC_64, header.magic);
+ }
#else
- if(header.magic != MH_MAGIC)
- return 0;
+ if(header.magic != MH_MAGIC) {
+ barf("Bad magic. Expected: %08x, got: %08x.",
+ MH_MAGIC, header.magic);
+ }
#endif
misalignment = (header.sizeofcmds + sizeof(header))
return misalignment ? (16 - misalignment) : 0;
}
-
#endif
+#endif
projects / ghc-hetmet.git / blobdiff