X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FLinker.c;h=4b984dac2d18b53ba2011c431fedf85533bd8fc6;hb=73dd6e8461229087a103a02628d364e366a759a2;hp=26d671e6e9820c4cb0d6a97bd5ef8760c0ece728;hpb=b9110541efb85f9489b1f9a0c95445419e61d86d;p=ghc-hetmet.git diff --git a/rts/Linker.c b/rts/Linker.c index 26d671e..4b984da 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -18,16 +18,23 @@ #endif #include "Rts.h" -#include "RtsFlags.h" #include "HsFFI.h" + +#include "sm/Storage.h" +#include "Stats.h" #include "Hash.h" -#include "Linker.h" #include "LinkerInternals.h" #include "RtsUtils.h" -#include "Schedule.h" -#include "Sparks.h" -#include "RtsTypeable.h" -#include "Timer.h" +#include "Trace.h" +#include "StgPrimFloat.h" // for __int_encodeFloat etc. +#include "Stable.h" + +#if !defined(mingw32_HOST_OS) +#include "posix/Signals.h" +#endif + +// get protos for is*() +#include #ifdef HAVE_SYS_TYPES_H #include @@ -35,6 +42,8 @@ #include #include +#include +#include #ifdef HAVE_SYS_STAT_H #include @@ -60,27 +69,28 @@ #include #endif -#if defined(ia64_HOST_ARCH) || defined(linux_HOST_OS) || defined(freebsd_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) #define USE_MMAP #include #include -#if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS) #ifdef HAVE_UNISTD_H #include #endif -#endif #endif -#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS) +#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 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 # include #elif defined(darwin_HOST_OS) # define OBJFORMAT_MACHO +# include # include # include # include @@ -95,6 +105,10 @@ #endif #endif +#if defined(x86_64_HOST_ARCH) && defined(darwin_HOST_OS) +#define ALWAYS_PIC +#endif + /* Hash table mapping symbol names to Symbol */ static /*Str*/HashTable *symhash; @@ -104,6 +118,16 @@ static /*Str*/HashTable *stablehash; /* 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 ); @@ -115,12 +139,16 @@ static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc ); static int ocVerifyImage_PEi386 ( ObjectCode* oc ); static int ocGetNames_PEi386 ( ObjectCode* oc ); static int ocResolve_PEi386 ( ObjectCode* oc ); +static void *lookupSymbolInDLLs ( unsigned char *lbl ); +static void zapTrailingAtSign ( unsigned char *sym ); #elif defined(OBJFORMAT_MACHO) static int ocVerifyImage_MachO ( 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 @@ -151,9 +179,65 @@ static void machoInitSymbolsWithoutUnderscore( void ); * * See bug #781 * See thread http://www.haskell.org/pipermail/cvs-ghc/2007-September/038458.html + * + * Naming Scheme for Symbol Macros + * + * SymI_*: symbol is internal to the RTS. It resides in an object + * file/library that is statically. + * SymE_*: symbol is external to the RTS library. It might be linked + * dynamically. + * + * Sym*_HasProto : the symbol prototype is imported in an include file + * or defined explicitly + * Sym*_NeedsProto: the symbol is undefined and we add a dummy + * default proto extern void sym(void); */ #define X86_64_ELF_NONPIC_HACK 1 +/* Link objects into the lower 2Gb on x86_64. GHC assumes the + * small memory model on this architecture (see gcc docs, + * -mcmodel=small). + * + * MAP_32BIT not available on OpenBSD/amd64 + */ +#if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT) +#define TRY_MAP_32BIT MAP_32BIT +#else +#define TRY_MAP_32BIT 0 +#endif + +/* + * Due to the small memory model (see above), on x86_64 we have to map + * all our non-PIC object files into the low 2Gb of the address space + * (why 2Gb and not 4Gb? Because all addresses must be reachable + * using a 32-bit signed PC-relative offset). On Linux we can do this + * using the MAP_32BIT flag to mmap(), however on other OSs + * (e.g. *BSD, see #2063, and also on Linux inside Xen, see #2512), we + * can't do this. So on these systems, we have to pick a base address + * in the low 2Gb of the address space and try to allocate memory from + * there. + * + * We pick a default address based on the OS, but also make this + * configurable via an RTS flag (+RTS -xm) + */ +#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH) + +#if defined(MAP_32BIT) +// Try to use MAP_32BIT +#define MMAP_32BIT_BASE_DEFAULT 0 +#else +// A guess: 1Gb. +#define MMAP_32BIT_BASE_DEFAULT 0x40000000 +#endif + +static void *mmap_32bit_base = (void *)MMAP_32BIT_BASE_DEFAULT; +#endif + +/* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */ +#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) +#define MAP_ANONYMOUS MAP_ANON +#endif + /* ----------------------------------------------------------------------------- * Built-in symbols from the RTS */ @@ -163,24 +247,21 @@ typedef struct _RtsSymbolVal { void *addr; } RtsSymbolVal; - -#if !defined(PAR) -#define Maybe_Stable_Names SymX(mkWeakzh_fast) \ - SymX(makeStableNamezh_fast) \ - SymX(finalizzeWeakzh_fast) -#else -/* These are not available in GUM!!! -- HWL */ -#define Maybe_Stable_Names -#endif +#define Maybe_Stable_Names SymI_HasProto(stg_mkWeakzh) \ + SymI_HasProto(stg_mkWeakForeignEnvzh) \ + SymI_HasProto(stg_makeStableNamezh) \ + SymI_HasProto(stg_finalizzeWeakzh) #if !defined (mingw32_HOST_OS) #define RTS_POSIX_ONLY_SYMBOLS \ - SymX(shutdownHaskellAndSignal) \ - Sym(lockFile) \ - Sym(unlockFile) \ - SymX(signal_handlers) \ - SymX(stg_sig_install) \ - Sym(nocldstop) + SymI_HasProto(__hscore_get_saved_termios) \ + SymI_HasProto(__hscore_set_saved_termios) \ + SymI_HasProto(shutdownHaskellAndSignal) \ + SymI_HasProto(lockFile) \ + SymI_HasProto(unlockFile) \ + SymI_HasProto(signal_handlers) \ + SymI_HasProto(stg_sig_install) \ + SymI_NeedsProto(nocldstop) #endif #if defined (cygwin32_HOST_OS) @@ -189,83 +270,83 @@ typedef struct _RtsSymbolVal { * we have to stupidly list a lot of what libcygwin.a * exports; sigh. */ -#define RTS_CYGWIN_ONLY_SYMBOLS \ - SymX(regfree) \ - SymX(regexec) \ - SymX(regerror) \ - SymX(regcomp) \ - SymX(__errno) \ - SymX(access) \ - SymX(chmod) \ - SymX(chdir) \ - SymX(close) \ - SymX(creat) \ - SymX(dup) \ - SymX(dup2) \ - SymX(fstat) \ - SymX(fcntl) \ - SymX(getcwd) \ - SymX(getenv) \ - SymX(lseek) \ - SymX(open) \ - SymX(fpathconf) \ - SymX(pathconf) \ - SymX(stat) \ - SymX(pow) \ - SymX(tanh) \ - SymX(cosh) \ - SymX(sinh) \ - SymX(atan) \ - SymX(acos) \ - SymX(asin) \ - SymX(tan) \ - SymX(cos) \ - SymX(sin) \ - SymX(exp) \ - SymX(log) \ - SymX(sqrt) \ - SymX(localtime_r) \ - SymX(gmtime_r) \ - SymX(mktime) \ - Sym(_imp___tzname) \ - SymX(gettimeofday) \ - SymX(timezone) \ - SymX(tcgetattr) \ - SymX(tcsetattr) \ - SymX(memcpy) \ - SymX(memmove) \ - SymX(realloc) \ - SymX(malloc) \ - SymX(free) \ - SymX(fork) \ - SymX(lstat) \ - SymX(isatty) \ - SymX(mkdir) \ - SymX(opendir) \ - SymX(readdir) \ - SymX(rewinddir) \ - SymX(closedir) \ - SymX(link) \ - SymX(mkfifo) \ - SymX(pipe) \ - SymX(read) \ - SymX(rename) \ - SymX(rmdir) \ - SymX(select) \ - SymX(system) \ - SymX(write) \ - SymX(strcmp) \ - SymX(strcpy) \ - SymX(strncpy) \ - SymX(strerror) \ - SymX(sigaddset) \ - SymX(sigemptyset) \ - SymX(sigprocmask) \ - SymX(umask) \ - SymX(uname) \ - SymX(unlink) \ - SymX(utime) \ - SymX(waitpid) +#define RTS_CYGWIN_ONLY_SYMBOLS \ + SymI_HasProto(regfree) \ + SymI_HasProto(regexec) \ + SymI_HasProto(regerror) \ + SymI_HasProto(regcomp) \ + SymI_HasProto(__errno) \ + SymI_HasProto(access) \ + SymI_HasProto(chmod) \ + SymI_HasProto(chdir) \ + SymI_HasProto(close) \ + SymI_HasProto(creat) \ + SymI_HasProto(dup) \ + SymI_HasProto(dup2) \ + SymI_HasProto(fstat) \ + SymI_HasProto(fcntl) \ + SymI_HasProto(getcwd) \ + SymI_HasProto(getenv) \ + SymI_HasProto(lseek) \ + SymI_HasProto(open) \ + SymI_HasProto(fpathconf) \ + SymI_HasProto(pathconf) \ + SymI_HasProto(stat) \ + SymI_HasProto(pow) \ + SymI_HasProto(tanh) \ + SymI_HasProto(cosh) \ + SymI_HasProto(sinh) \ + SymI_HasProto(atan) \ + SymI_HasProto(acos) \ + SymI_HasProto(asin) \ + SymI_HasProto(tan) \ + SymI_HasProto(cos) \ + SymI_HasProto(sin) \ + SymI_HasProto(exp) \ + SymI_HasProto(log) \ + SymI_HasProto(sqrt) \ + SymI_HasProto(localtime_r) \ + SymI_HasProto(gmtime_r) \ + SymI_HasProto(mktime) \ + SymI_NeedsProto(_imp___tzname) \ + SymI_HasProto(gettimeofday) \ + SymI_HasProto(timezone) \ + SymI_HasProto(tcgetattr) \ + SymI_HasProto(tcsetattr) \ + SymI_HasProto(memcpy) \ + SymI_HasProto(memmove) \ + SymI_HasProto(realloc) \ + SymI_HasProto(malloc) \ + SymI_HasProto(free) \ + SymI_HasProto(fork) \ + SymI_HasProto(lstat) \ + SymI_HasProto(isatty) \ + SymI_HasProto(mkdir) \ + SymI_HasProto(opendir) \ + SymI_HasProto(readdir) \ + SymI_HasProto(rewinddir) \ + SymI_HasProto(closedir) \ + SymI_HasProto(link) \ + SymI_HasProto(mkfifo) \ + SymI_HasProto(pipe) \ + SymI_HasProto(read) \ + SymI_HasProto(rename) \ + SymI_HasProto(rmdir) \ + SymI_HasProto(select) \ + SymI_HasProto(system) \ + SymI_HasProto(write) \ + SymI_HasProto(strcmp) \ + SymI_HasProto(strcpy) \ + SymI_HasProto(strncpy) \ + SymI_HasProto(strerror) \ + SymI_HasProto(sigaddset) \ + SymI_HasProto(sigemptyset) \ + SymI_HasProto(sigprocmask) \ + SymI_HasProto(umask) \ + SymI_HasProto(uname) \ + SymI_HasProto(unlink) \ + SymI_HasProto(utime) \ + SymI_HasProto(waitpid) #elif !defined(mingw32_HOST_OS) #define RTS_MINGW_ONLY_SYMBOLS /**/ @@ -274,556 +355,651 @@ typedef struct _RtsSymbolVal { #define RTS_POSIX_ONLY_SYMBOLS /**/ #define RTS_CYGWIN_ONLY_SYMBOLS /**/ -/* Extra syms gen'ed by mingw-2's gcc-3.2: */ -#if __GNUC__>=3 -#define RTS_MINGW_EXTRA_SYMS \ - Sym(_imp____mb_cur_max) \ - Sym(_imp___pctype) +#if HAVE_GETTIMEOFDAY +#define RTS_MINGW_GETTIMEOFDAY_SYM SymI_NeedsProto(gettimeofday) #else -#define RTS_MINGW_EXTRA_SYMS +#define RTS_MINGW_GETTIMEOFDAY_SYM /**/ #endif -#if HAVE_GETTIMEOFDAY -#define RTS_MINGW_GETTIMEOFDAY_SYM Sym(gettimeofday) +#if HAVE___MINGW_VFPRINTF +#define RTS___MINGW_VFPRINTF_SYM SymI_HasProto(__mingw_vfprintf) #else -#define RTS_MINGW_GETTIMEOFDAY_SYM /**/ +#define RTS___MINGW_VFPRINTF_SYM /**/ #endif /* These are statically linked from the mingw libraries into the ghc executable, so we have to employ this hack. */ -#define RTS_MINGW_ONLY_SYMBOLS \ - SymX(asyncReadzh_fast) \ - SymX(asyncWritezh_fast) \ - SymX(asyncDoProczh_fast) \ - SymX(memset) \ - SymX(inet_ntoa) \ - SymX(inet_addr) \ - 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(powf) \ - SymX(tanhf) \ - SymX(coshf) \ - SymX(sinhf) \ - SymX(atanf) \ - SymX(acosf) \ - SymX(asinf) \ - SymX(tanf) \ - SymX(cosf) \ - SymX(sinf) \ - SymX(expf) \ - SymX(logf) \ - SymX(sqrtf) \ - SymX(memcpy) \ - SymX(rts_InstallConsoleEvent) \ - SymX(rts_ConsoleHandlerDone) \ - Sym(mktime) \ - Sym(_imp___timezone) \ - Sym(_imp___tzname) \ - Sym(_imp__tzname) \ - Sym(_imp___iob) \ - Sym(_imp___osver) \ - Sym(localtime) \ - Sym(gmtime) \ - Sym(opendir) \ - Sym(readdir) \ - Sym(rewinddir) \ - RTS_MINGW_EXTRA_SYMS \ - RTS_MINGW_GETTIMEOFDAY_SYM \ - Sym(closedir) +#define RTS_MINGW_ONLY_SYMBOLS \ + SymI_HasProto(stg_asyncReadzh) \ + SymI_HasProto(stg_asyncWritezh) \ + SymI_HasProto(stg_asyncDoProczh) \ + SymI_HasProto(memset) \ + SymI_HasProto(inet_ntoa) \ + SymI_HasProto(inet_addr) \ + SymI_HasProto(htonl) \ + SymI_HasProto(recvfrom) \ + SymI_HasProto(listen) \ + SymI_HasProto(bind) \ + SymI_HasProto(shutdown) \ + SymI_HasProto(connect) \ + SymI_HasProto(htons) \ + SymI_HasProto(ntohs) \ + SymI_HasProto(getservbyname) \ + SymI_HasProto(getservbyport) \ + SymI_HasProto(getprotobynumber) \ + SymI_HasProto(getprotobyname) \ + SymI_HasProto(gethostbyname) \ + SymI_HasProto(gethostbyaddr) \ + SymI_HasProto(gethostname) \ + SymI_HasProto(strcpy) \ + SymI_HasProto(strncpy) \ + SymI_HasProto(abort) \ + SymI_NeedsProto(_alloca) \ + SymI_HasProto(isxdigit) \ + SymI_HasProto(isupper) \ + SymI_HasProto(ispunct) \ + SymI_HasProto(islower) \ + SymI_HasProto(isspace) \ + SymI_HasProto(isprint) \ + SymI_HasProto(isdigit) \ + SymI_HasProto(iscntrl) \ + SymI_HasProto(isalpha) \ + SymI_HasProto(isalnum) \ + SymI_HasProto(isascii) \ + RTS___MINGW_VFPRINTF_SYM \ + SymI_HasProto(strcmp) \ + SymI_HasProto(memmove) \ + SymI_HasProto(realloc) \ + SymI_HasProto(malloc) \ + SymI_HasProto(pow) \ + SymI_HasProto(tanh) \ + SymI_HasProto(cosh) \ + SymI_HasProto(sinh) \ + SymI_HasProto(atan) \ + SymI_HasProto(acos) \ + SymI_HasProto(asin) \ + SymI_HasProto(tan) \ + SymI_HasProto(cos) \ + SymI_HasProto(sin) \ + SymI_HasProto(exp) \ + SymI_HasProto(log) \ + SymI_HasProto(sqrt) \ + SymI_HasProto(powf) \ + SymI_HasProto(tanhf) \ + SymI_HasProto(coshf) \ + SymI_HasProto(sinhf) \ + SymI_HasProto(atanf) \ + SymI_HasProto(acosf) \ + SymI_HasProto(asinf) \ + SymI_HasProto(tanf) \ + SymI_HasProto(cosf) \ + SymI_HasProto(sinf) \ + SymI_HasProto(expf) \ + SymI_HasProto(logf) \ + SymI_HasProto(sqrtf) \ + SymI_HasProto(erf) \ + SymI_HasProto(erfc) \ + SymI_HasProto(erff) \ + SymI_HasProto(erfcf) \ + SymI_HasProto(memcpy) \ + SymI_HasProto(rts_InstallConsoleEvent) \ + SymI_HasProto(rts_ConsoleHandlerDone) \ + SymI_NeedsProto(mktime) \ + SymI_NeedsProto(_imp___timezone) \ + SymI_NeedsProto(_imp___tzname) \ + SymI_NeedsProto(_imp__tzname) \ + SymI_NeedsProto(_imp___iob) \ + SymI_NeedsProto(_imp___osver) \ + SymI_NeedsProto(localtime) \ + SymI_NeedsProto(gmtime) \ + SymI_NeedsProto(opendir) \ + SymI_NeedsProto(readdir) \ + SymI_NeedsProto(rewinddir) \ + SymI_NeedsProto(_imp____mb_cur_max) \ + SymI_NeedsProto(_imp___pctype) \ + SymI_NeedsProto(__chkstk) \ + RTS_MINGW_GETTIMEOFDAY_SYM \ + SymI_NeedsProto(closedir) #endif -#if defined(darwin_TARGET_OS) && HAVE_PRINTF_LDBLSTUB -#define RTS_DARWIN_ONLY_SYMBOLS \ - Sym(asprintf$LDBLStub) \ - Sym(err$LDBLStub) \ - Sym(errc$LDBLStub) \ - Sym(errx$LDBLStub) \ - Sym(fprintf$LDBLStub) \ - Sym(fscanf$LDBLStub) \ - Sym(fwprintf$LDBLStub) \ - Sym(fwscanf$LDBLStub) \ - Sym(printf$LDBLStub) \ - Sym(scanf$LDBLStub) \ - Sym(snprintf$LDBLStub) \ - Sym(sprintf$LDBLStub) \ - Sym(sscanf$LDBLStub) \ - Sym(strtold$LDBLStub) \ - Sym(swprintf$LDBLStub) \ - Sym(swscanf$LDBLStub) \ - Sym(syslog$LDBLStub) \ - Sym(vasprintf$LDBLStub) \ - Sym(verr$LDBLStub) \ - Sym(verrc$LDBLStub) \ - Sym(verrx$LDBLStub) \ - Sym(vfprintf$LDBLStub) \ - Sym(vfscanf$LDBLStub) \ - Sym(vfwprintf$LDBLStub) \ - Sym(vfwscanf$LDBLStub) \ - Sym(vprintf$LDBLStub) \ - Sym(vscanf$LDBLStub) \ - Sym(vsnprintf$LDBLStub) \ - Sym(vsprintf$LDBLStub) \ - Sym(vsscanf$LDBLStub) \ - Sym(vswprintf$LDBLStub) \ - Sym(vswscanf$LDBLStub) \ - Sym(vsyslog$LDBLStub) \ - Sym(vwarn$LDBLStub) \ - Sym(vwarnc$LDBLStub) \ - Sym(vwarnx$LDBLStub) \ - Sym(vwprintf$LDBLStub) \ - Sym(vwscanf$LDBLStub) \ - Sym(warn$LDBLStub) \ - Sym(warnc$LDBLStub) \ - Sym(warnx$LDBLStub) \ - Sym(wcstold$LDBLStub) \ - Sym(wprintf$LDBLStub) \ - Sym(wscanf$LDBLStub) + +#if defined(darwin_HOST_OS) && HAVE_PRINTF_LDBLSTUB +#define RTS_DARWIN_ONLY_SYMBOLS \ + SymI_NeedsProto(asprintf$LDBLStub) \ + SymI_NeedsProto(err$LDBLStub) \ + SymI_NeedsProto(errc$LDBLStub) \ + SymI_NeedsProto(errx$LDBLStub) \ + SymI_NeedsProto(fprintf$LDBLStub) \ + SymI_NeedsProto(fscanf$LDBLStub) \ + SymI_NeedsProto(fwprintf$LDBLStub) \ + SymI_NeedsProto(fwscanf$LDBLStub) \ + SymI_NeedsProto(printf$LDBLStub) \ + SymI_NeedsProto(scanf$LDBLStub) \ + SymI_NeedsProto(snprintf$LDBLStub) \ + SymI_NeedsProto(sprintf$LDBLStub) \ + SymI_NeedsProto(sscanf$LDBLStub) \ + SymI_NeedsProto(strtold$LDBLStub) \ + SymI_NeedsProto(swprintf$LDBLStub) \ + SymI_NeedsProto(swscanf$LDBLStub) \ + SymI_NeedsProto(syslog$LDBLStub) \ + SymI_NeedsProto(vasprintf$LDBLStub) \ + SymI_NeedsProto(verr$LDBLStub) \ + SymI_NeedsProto(verrc$LDBLStub) \ + SymI_NeedsProto(verrx$LDBLStub) \ + SymI_NeedsProto(vfprintf$LDBLStub) \ + SymI_NeedsProto(vfscanf$LDBLStub) \ + SymI_NeedsProto(vfwprintf$LDBLStub) \ + SymI_NeedsProto(vfwscanf$LDBLStub) \ + SymI_NeedsProto(vprintf$LDBLStub) \ + SymI_NeedsProto(vscanf$LDBLStub) \ + SymI_NeedsProto(vsnprintf$LDBLStub) \ + SymI_NeedsProto(vsprintf$LDBLStub) \ + SymI_NeedsProto(vsscanf$LDBLStub) \ + SymI_NeedsProto(vswprintf$LDBLStub) \ + SymI_NeedsProto(vswscanf$LDBLStub) \ + SymI_NeedsProto(vsyslog$LDBLStub) \ + SymI_NeedsProto(vwarn$LDBLStub) \ + SymI_NeedsProto(vwarnc$LDBLStub) \ + SymI_NeedsProto(vwarnx$LDBLStub) \ + SymI_NeedsProto(vwprintf$LDBLStub) \ + SymI_NeedsProto(vwscanf$LDBLStub) \ + SymI_NeedsProto(warn$LDBLStub) \ + SymI_NeedsProto(warnc$LDBLStub) \ + SymI_NeedsProto(warnx$LDBLStub) \ + SymI_NeedsProto(wcstold$LDBLStub) \ + SymI_NeedsProto(wprintf$LDBLStub) \ + SymI_NeedsProto(wscanf$LDBLStub) #else #define RTS_DARWIN_ONLY_SYMBOLS #endif #ifndef SMP -# define MAIN_CAP_SYM SymX(MainCapability) +# define MAIN_CAP_SYM SymI_HasProto(MainCapability) #else # define MAIN_CAP_SYM #endif #if !defined(mingw32_HOST_OS) #define RTS_USER_SIGNALS_SYMBOLS \ - SymX(setIOManagerPipe) + SymI_HasProto(setIOManagerControlFd) \ + SymI_HasProto(setIOManagerWakeupFd) \ + SymI_HasProto(ioManagerWakeup) \ + SymI_HasProto(blockUserSignals) \ + SymI_HasProto(unblockUserSignals) #else -#define RTS_USER_SIGNALS_SYMBOLS \ - SymX(sendIOManagerEvent) \ - SymX(readIOManagerEvent) \ - SymX(getIOManagerEvent) \ - SymX(console_handler) +#define RTS_USER_SIGNALS_SYMBOLS \ + SymI_HasProto(ioManagerWakeup) \ + SymI_HasProto(sendIOManagerEvent) \ + SymI_HasProto(readIOManagerEvent) \ + SymI_HasProto(getIOManagerEvent) \ + SymI_HasProto(console_handler) #endif -#define RTS_LIBFFI_SYMBOLS \ - Sym(ffi_prep_cif) \ - Sym(ffi_call) \ - Sym(ffi_type_void) \ - Sym(ffi_type_float) \ - Sym(ffi_type_double) \ - Sym(ffi_type_sint64) \ - Sym(ffi_type_uint64) \ - Sym(ffi_type_sint32) \ - Sym(ffi_type_uint32) \ - Sym(ffi_type_sint16) \ - Sym(ffi_type_uint16) \ - Sym(ffi_type_sint8) \ - Sym(ffi_type_uint8) \ - Sym(ffi_type_pointer) +#define RTS_LIBFFI_SYMBOLS \ + SymE_NeedsProto(ffi_prep_cif) \ + SymE_NeedsProto(ffi_call) \ + SymE_NeedsProto(ffi_type_void) \ + SymE_NeedsProto(ffi_type_float) \ + SymE_NeedsProto(ffi_type_double) \ + SymE_NeedsProto(ffi_type_sint64) \ + SymE_NeedsProto(ffi_type_uint64) \ + SymE_NeedsProto(ffi_type_sint32) \ + SymE_NeedsProto(ffi_type_uint32) \ + SymE_NeedsProto(ffi_type_sint16) \ + SymE_NeedsProto(ffi_type_uint16) \ + SymE_NeedsProto(ffi_type_sint8) \ + SymE_NeedsProto(ffi_type_uint8) \ + SymE_NeedsProto(ffi_type_pointer) #ifdef TABLES_NEXT_TO_CODE #define RTS_RET_SYMBOLS /* nothing */ #else -#define RTS_RET_SYMBOLS \ - SymX(stg_enter_ret) \ - SymX(stg_gc_fun_ret) \ - SymX(stg_ap_v_ret) \ - SymX(stg_ap_f_ret) \ - SymX(stg_ap_d_ret) \ - SymX(stg_ap_l_ret) \ - SymX(stg_ap_n_ret) \ - SymX(stg_ap_p_ret) \ - SymX(stg_ap_pv_ret) \ - SymX(stg_ap_pp_ret) \ - SymX(stg_ap_ppv_ret) \ - SymX(stg_ap_ppp_ret) \ - SymX(stg_ap_pppv_ret) \ - SymX(stg_ap_pppp_ret) \ - SymX(stg_ap_ppppp_ret) \ - SymX(stg_ap_pppppp_ret) +#define RTS_RET_SYMBOLS \ + SymI_HasProto(stg_enter_ret) \ + SymI_HasProto(stg_gc_fun_ret) \ + SymI_HasProto(stg_ap_v_ret) \ + SymI_HasProto(stg_ap_f_ret) \ + SymI_HasProto(stg_ap_d_ret) \ + SymI_HasProto(stg_ap_l_ret) \ + SymI_HasProto(stg_ap_n_ret) \ + SymI_HasProto(stg_ap_p_ret) \ + SymI_HasProto(stg_ap_pv_ret) \ + SymI_HasProto(stg_ap_pp_ret) \ + SymI_HasProto(stg_ap_ppv_ret) \ + SymI_HasProto(stg_ap_ppp_ret) \ + SymI_HasProto(stg_ap_pppv_ret) \ + SymI_HasProto(stg_ap_pppp_ret) \ + SymI_HasProto(stg_ap_ppppp_ret) \ + SymI_HasProto(stg_ap_pppppp_ret) #endif -/* On Windows, we link libgmp.a statically into libHSrts.dll */ -#ifdef mingw32_HOST_OS -#define GMP_SYMS \ - SymX(__gmpz_cmp) \ - SymX(__gmpz_cmp_si) \ - SymX(__gmpz_cmp_ui) \ - SymX(__gmpz_get_si) \ - SymX(__gmpz_get_ui) +/* Modules compiled with -ticky may mention ticky counters */ +/* This list should marry up with the one in $(TOP)/includes/stg/Ticky.h */ +#define RTS_TICKY_SYMBOLS \ + SymI_NeedsProto(ticky_entry_ctrs) \ + SymI_NeedsProto(top_ct) \ + \ + SymI_HasProto(ENT_VIA_NODE_ctr) \ + SymI_HasProto(ENT_STATIC_THK_ctr) \ + SymI_HasProto(ENT_DYN_THK_ctr) \ + SymI_HasProto(ENT_STATIC_FUN_DIRECT_ctr) \ + SymI_HasProto(ENT_DYN_FUN_DIRECT_ctr) \ + SymI_HasProto(ENT_STATIC_CON_ctr) \ + SymI_HasProto(ENT_DYN_CON_ctr) \ + SymI_HasProto(ENT_STATIC_IND_ctr) \ + SymI_HasProto(ENT_DYN_IND_ctr) \ + SymI_HasProto(ENT_PERM_IND_ctr) \ + SymI_HasProto(ENT_PAP_ctr) \ + SymI_HasProto(ENT_AP_ctr) \ + SymI_HasProto(ENT_AP_STACK_ctr) \ + SymI_HasProto(ENT_BH_ctr) \ + SymI_HasProto(UNKNOWN_CALL_ctr) \ + SymI_HasProto(SLOW_CALL_v_ctr) \ + SymI_HasProto(SLOW_CALL_f_ctr) \ + SymI_HasProto(SLOW_CALL_d_ctr) \ + SymI_HasProto(SLOW_CALL_l_ctr) \ + SymI_HasProto(SLOW_CALL_n_ctr) \ + SymI_HasProto(SLOW_CALL_p_ctr) \ + SymI_HasProto(SLOW_CALL_pv_ctr) \ + SymI_HasProto(SLOW_CALL_pp_ctr) \ + SymI_HasProto(SLOW_CALL_ppv_ctr) \ + SymI_HasProto(SLOW_CALL_ppp_ctr) \ + SymI_HasProto(SLOW_CALL_pppv_ctr) \ + SymI_HasProto(SLOW_CALL_pppp_ctr) \ + SymI_HasProto(SLOW_CALL_ppppp_ctr) \ + SymI_HasProto(SLOW_CALL_pppppp_ctr) \ + SymI_HasProto(SLOW_CALL_OTHER_ctr) \ + SymI_HasProto(ticky_slow_call_unevald) \ + SymI_HasProto(SLOW_CALL_ctr) \ + SymI_HasProto(MULTI_CHUNK_SLOW_CALL_ctr) \ + SymI_HasProto(MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr) \ + SymI_HasProto(KNOWN_CALL_ctr) \ + SymI_HasProto(KNOWN_CALL_TOO_FEW_ARGS_ctr) \ + SymI_HasProto(KNOWN_CALL_EXTRA_ARGS_ctr) \ + SymI_HasProto(SLOW_CALL_FUN_TOO_FEW_ctr) \ + SymI_HasProto(SLOW_CALL_FUN_CORRECT_ctr) \ + SymI_HasProto(SLOW_CALL_FUN_TOO_MANY_ctr) \ + SymI_HasProto(SLOW_CALL_PAP_TOO_FEW_ctr) \ + SymI_HasProto(SLOW_CALL_PAP_CORRECT_ctr) \ + SymI_HasProto(SLOW_CALL_PAP_TOO_MANY_ctr) \ + SymI_HasProto(SLOW_CALL_UNEVALD_ctr) \ + SymI_HasProto(UPDF_OMITTED_ctr) \ + SymI_HasProto(UPDF_PUSHED_ctr) \ + SymI_HasProto(CATCHF_PUSHED_ctr) \ + SymI_HasProto(UPDF_RCC_PUSHED_ctr) \ + SymI_HasProto(UPDF_RCC_OMITTED_ctr) \ + SymI_HasProto(UPD_SQUEEZED_ctr) \ + SymI_HasProto(UPD_CON_IN_NEW_ctr) \ + SymI_HasProto(UPD_CON_IN_PLACE_ctr) \ + SymI_HasProto(UPD_PAP_IN_NEW_ctr) \ + SymI_HasProto(UPD_PAP_IN_PLACE_ctr) \ + SymI_HasProto(ALLOC_HEAP_ctr) \ + SymI_HasProto(ALLOC_HEAP_tot) \ + SymI_HasProto(ALLOC_FUN_ctr) \ + SymI_HasProto(ALLOC_FUN_adm) \ + SymI_HasProto(ALLOC_FUN_gds) \ + SymI_HasProto(ALLOC_FUN_slp) \ + SymI_HasProto(UPD_NEW_IND_ctr) \ + SymI_HasProto(UPD_NEW_PERM_IND_ctr) \ + SymI_HasProto(UPD_OLD_IND_ctr) \ + SymI_HasProto(UPD_OLD_PERM_IND_ctr) \ + SymI_HasProto(UPD_BH_UPDATABLE_ctr) \ + SymI_HasProto(UPD_BH_SINGLE_ENTRY_ctr) \ + SymI_HasProto(UPD_CAF_BH_UPDATABLE_ctr) \ + SymI_HasProto(UPD_CAF_BH_SINGLE_ENTRY_ctr) \ + SymI_HasProto(GC_SEL_ABANDONED_ctr) \ + SymI_HasProto(GC_SEL_MINOR_ctr) \ + SymI_HasProto(GC_SEL_MAJOR_ctr) \ + SymI_HasProto(GC_FAILED_PROMOTION_ctr) \ + SymI_HasProto(ALLOC_UP_THK_ctr) \ + SymI_HasProto(ALLOC_SE_THK_ctr) \ + SymI_HasProto(ALLOC_THK_adm) \ + SymI_HasProto(ALLOC_THK_gds) \ + SymI_HasProto(ALLOC_THK_slp) \ + SymI_HasProto(ALLOC_CON_ctr) \ + SymI_HasProto(ALLOC_CON_adm) \ + SymI_HasProto(ALLOC_CON_gds) \ + SymI_HasProto(ALLOC_CON_slp) \ + SymI_HasProto(ALLOC_TUP_ctr) \ + SymI_HasProto(ALLOC_TUP_adm) \ + SymI_HasProto(ALLOC_TUP_gds) \ + SymI_HasProto(ALLOC_TUP_slp) \ + SymI_HasProto(ALLOC_BH_ctr) \ + SymI_HasProto(ALLOC_BH_adm) \ + SymI_HasProto(ALLOC_BH_gds) \ + SymI_HasProto(ALLOC_BH_slp) \ + SymI_HasProto(ALLOC_PRIM_ctr) \ + SymI_HasProto(ALLOC_PRIM_adm) \ + SymI_HasProto(ALLOC_PRIM_gds) \ + SymI_HasProto(ALLOC_PRIM_slp) \ + SymI_HasProto(ALLOC_PAP_ctr) \ + SymI_HasProto(ALLOC_PAP_adm) \ + SymI_HasProto(ALLOC_PAP_gds) \ + SymI_HasProto(ALLOC_PAP_slp) \ + SymI_HasProto(ALLOC_TSO_ctr) \ + SymI_HasProto(ALLOC_TSO_adm) \ + SymI_HasProto(ALLOC_TSO_gds) \ + SymI_HasProto(ALLOC_TSO_slp) \ + SymI_HasProto(RET_NEW_ctr) \ + SymI_HasProto(RET_OLD_ctr) \ + SymI_HasProto(RET_UNBOXED_TUP_ctr) \ + SymI_HasProto(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 GMP_SYMS \ - SymExtern(__gmpz_cmp) \ - SymExtern(__gmpz_cmp_si) \ - SymExtern(__gmpz_cmp_ui) \ - SymExtern(__gmpz_get_si) \ - SymExtern(__gmpz_get_ui) +#define RTS_INTCHAR_SYMBOLS \ + SymI_HasProto(stg_CHARLIKE_closure) \ + SymI_HasProto(stg_INTLIKE_closure) #endif -#define RTS_SYMBOLS \ - Maybe_Stable_Names \ - SymX(StgReturn) \ - SymX(stg_enter_info) \ - SymX(stg_gc_void_info) \ - SymX(__stg_gc_enter_1) \ - SymX(stg_gc_noregs) \ - SymX(stg_gc_unpt_r1_info) \ - SymX(stg_gc_unpt_r1) \ - SymX(stg_gc_unbx_r1_info) \ - SymX(stg_gc_unbx_r1) \ - SymX(stg_gc_f1_info) \ - SymX(stg_gc_f1) \ - SymX(stg_gc_d1_info) \ - SymX(stg_gc_d1) \ - SymX(stg_gc_l1_info) \ - SymX(stg_gc_l1) \ - SymX(__stg_gc_fun) \ - SymX(stg_gc_fun_info) \ - SymX(stg_gc_gen) \ - SymX(stg_gc_gen_info) \ - SymX(stg_gc_gen_hp) \ - SymX(stg_gc_ut) \ - SymX(stg_gen_yield) \ - SymX(stg_yield_noregs) \ - SymX(stg_yield_to_interpreter) \ - SymX(stg_gen_block) \ - SymX(stg_block_noregs) \ - SymX(stg_block_1) \ - SymX(stg_block_takemvar) \ - SymX(stg_block_putmvar) \ - MAIN_CAP_SYM \ - SymX(MallocFailHook) \ - SymX(OnExitHook) \ - SymX(OutOfHeapHook) \ - SymX(StackOverflowHook) \ - SymX(__encodeDouble) \ - SymX(__encodeFloat) \ - SymX(addDLL) \ - GMP_SYMS \ - SymX(__int_encodeDouble) \ - SymX(__word_encodeDouble) \ - SymX(__2Int_encodeDouble) \ - SymX(__int_encodeFloat) \ - SymX(__word_encodeFloat) \ - SymX(andIntegerzh_fast) \ - SymX(atomicallyzh_fast) \ - SymX(barf) \ - SymX(debugBelch) \ - SymX(errorBelch) \ - SymX(asyncExceptionsBlockedzh_fast) \ - SymX(blockAsyncExceptionszh_fast) \ - SymX(catchzh_fast) \ - SymX(catchRetryzh_fast) \ - SymX(catchSTMzh_fast) \ - SymX(checkzh_fast) \ - SymX(closure_flags) \ - SymX(cmp_thread) \ - SymX(cmpIntegerzh_fast) \ - SymX(cmpIntegerIntzh_fast) \ - SymX(complementIntegerzh_fast) \ - SymX(createAdjustor) \ - SymX(decodeDoublezh_fast) \ - SymX(decodeFloatzh_fast) \ - SymX(decodeDoublezu2Intzh_fast) \ - SymX(decodeFloatzuIntzh_fast) \ - SymX(defaultsHook) \ - SymX(delayzh_fast) \ - SymX(deRefWeakzh_fast) \ - SymX(deRefStablePtrzh_fast) \ - SymX(dirty_MUT_VAR) \ - SymX(divExactIntegerzh_fast) \ - SymX(divModIntegerzh_fast) \ - SymX(forkzh_fast) \ - SymX(forkOnzh_fast) \ - SymX(forkProcess) \ - SymX(forkOS_createThread) \ - SymX(freeHaskellFunctionPtr) \ - SymX(freeStablePtr) \ - SymX(getOrSetTypeableStore) \ - SymX(gcdIntegerzh_fast) \ - SymX(gcdIntegerIntzh_fast) \ - SymX(gcdIntzh_fast) \ - SymX(genSymZh) \ - SymX(genericRaise) \ - SymX(getProgArgv) \ - SymX(getFullProgArgv) \ - SymX(getStablePtr) \ - SymX(hs_init) \ - SymX(hs_exit) \ - SymX(hs_set_argv) \ - SymX(hs_add_root) \ - SymX(hs_perform_gc) \ - SymX(hs_free_stable_ptr) \ - SymX(hs_free_fun_ptr) \ - SymX(hs_hpc_rootModule) \ - SymX(initLinker) \ - SymX(unpackClosurezh_fast) \ - SymX(getApStackValzh_fast) \ - SymX(int2Integerzh_fast) \ - SymX(integer2Intzh_fast) \ - SymX(integer2Wordzh_fast) \ - SymX(isCurrentThreadBoundzh_fast) \ - SymX(isDoubleDenormalized) \ - SymX(isDoubleInfinite) \ - SymX(isDoubleNaN) \ - SymX(isDoubleNegativeZero) \ - SymX(isEmptyMVarzh_fast) \ - SymX(isFloatDenormalized) \ - SymX(isFloatInfinite) \ - SymX(isFloatNaN) \ - SymX(isFloatNegativeZero) \ - SymX(killThreadzh_fast) \ - SymX(loadObj) \ - SymX(insertStableSymbol) \ - SymX(insertSymbol) \ - SymX(lookupSymbol) \ - SymX(makeStablePtrzh_fast) \ - SymX(minusIntegerzh_fast) \ - SymX(mkApUpd0zh_fast) \ - SymX(myThreadIdzh_fast) \ - SymX(labelThreadzh_fast) \ - SymX(newArrayzh_fast) \ - SymX(newBCOzh_fast) \ - SymX(newByteArrayzh_fast) \ - SymX_redirect(newCAF, newDynCAF) \ - SymX(newMVarzh_fast) \ - SymX(newMutVarzh_fast) \ - SymX(newTVarzh_fast) \ - SymX(noDuplicatezh_fast) \ - SymX(atomicModifyMutVarzh_fast) \ - SymX(newPinnedByteArrayzh_fast) \ - SymX(newSpark) \ - SymX(orIntegerzh_fast) \ - SymX(performGC) \ - SymX(performMajorGC) \ - SymX(plusIntegerzh_fast) \ - SymX(prog_argc) \ - SymX(prog_argv) \ - SymX(putMVarzh_fast) \ - SymX(quotIntegerzh_fast) \ - SymX(quotRemIntegerzh_fast) \ - SymX(raisezh_fast) \ - SymX(raiseIOzh_fast) \ - SymX(readTVarzh_fast) \ - SymX(remIntegerzh_fast) \ - SymX(resetNonBlockingFd) \ - SymX(resumeThread) \ - SymX(resolveObjs) \ - SymX(retryzh_fast) \ - SymX(rts_apply) \ - SymX(rts_checkSchedStatus) \ - SymX(rts_eval) \ - SymX(rts_evalIO) \ - SymX(rts_evalLazyIO) \ - SymX(rts_evalStableIO) \ - SymX(rts_eval_) \ - SymX(rts_getBool) \ - SymX(rts_getChar) \ - SymX(rts_getDouble) \ - SymX(rts_getFloat) \ - SymX(rts_getInt) \ - SymX(rts_getInt8) \ - SymX(rts_getInt16) \ - SymX(rts_getInt32) \ - SymX(rts_getInt64) \ - SymX(rts_getPtr) \ - SymX(rts_getFunPtr) \ - SymX(rts_getStablePtr) \ - SymX(rts_getThreadId) \ - SymX(rts_getWord) \ - SymX(rts_getWord8) \ - SymX(rts_getWord16) \ - SymX(rts_getWord32) \ - SymX(rts_getWord64) \ - SymX(rts_lock) \ - SymX(rts_mkBool) \ - SymX(rts_mkChar) \ - SymX(rts_mkDouble) \ - SymX(rts_mkFloat) \ - SymX(rts_mkInt) \ - SymX(rts_mkInt8) \ - SymX(rts_mkInt16) \ - SymX(rts_mkInt32) \ - SymX(rts_mkInt64) \ - SymX(rts_mkPtr) \ - SymX(rts_mkFunPtr) \ - SymX(rts_mkStablePtr) \ - SymX(rts_mkString) \ - SymX(rts_mkWord) \ - SymX(rts_mkWord8) \ - SymX(rts_mkWord16) \ - SymX(rts_mkWord32) \ - SymX(rts_mkWord64) \ - SymX(rts_unlock) \ - SymX(rtsSupportsBoundThreads) \ - SymX(__hscore_get_saved_termios) \ - SymX(__hscore_set_saved_termios) \ - SymX(setProgArgv) \ - SymX(startupHaskell) \ - SymX(shutdownHaskell) \ - SymX(shutdownHaskellAndExit) \ - SymX(stable_ptr_table) \ - SymX(stackOverflow) \ - SymX(stg_CAF_BLACKHOLE_info) \ - SymX(awakenBlockedQueue) \ - SymX(startTimer) \ - SymX(stg_CHARLIKE_closure) \ - SymX(stg_MVAR_CLEAN_info) \ - SymX(stg_MVAR_DIRTY_info) \ - SymX(stg_IND_STATIC_info) \ - SymX(stg_INTLIKE_closure) \ - SymX(stg_MUT_ARR_PTRS_DIRTY_info) \ - SymX(stg_MUT_ARR_PTRS_FROZEN_info) \ - SymX(stg_MUT_ARR_PTRS_FROZEN0_info) \ - SymX(stg_WEAK_info) \ - SymX(stg_ap_v_info) \ - SymX(stg_ap_f_info) \ - SymX(stg_ap_d_info) \ - SymX(stg_ap_l_info) \ - SymX(stg_ap_n_info) \ - SymX(stg_ap_p_info) \ - SymX(stg_ap_pv_info) \ - SymX(stg_ap_pp_info) \ - SymX(stg_ap_ppv_info) \ - SymX(stg_ap_ppp_info) \ - SymX(stg_ap_pppv_info) \ - SymX(stg_ap_pppp_info) \ - SymX(stg_ap_ppppp_info) \ - SymX(stg_ap_pppppp_info) \ - SymX(stg_ap_0_fast) \ - SymX(stg_ap_v_fast) \ - SymX(stg_ap_f_fast) \ - SymX(stg_ap_d_fast) \ - SymX(stg_ap_l_fast) \ - SymX(stg_ap_n_fast) \ - SymX(stg_ap_p_fast) \ - SymX(stg_ap_pv_fast) \ - SymX(stg_ap_pp_fast) \ - SymX(stg_ap_ppv_fast) \ - SymX(stg_ap_ppp_fast) \ - SymX(stg_ap_pppv_fast) \ - SymX(stg_ap_pppp_fast) \ - SymX(stg_ap_ppppp_fast) \ - SymX(stg_ap_pppppp_fast) \ - 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_5_upd_info) \ - SymX(stg_ap_6_upd_info) \ - SymX(stg_ap_7_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_4_upd_info) \ - SymX(stg_sel_5_upd_info) \ - SymX(stg_sel_6_upd_info) \ - SymX(stg_sel_7_upd_info) \ - SymX(stg_sel_8_upd_info) \ - SymX(stg_sel_9_upd_info) \ - SymX(stg_upd_frame_info) \ - SymX(suspendThread) \ - SymX(takeMVarzh_fast) \ - SymX(threadStatuszh_fast) \ - SymX(timesIntegerzh_fast) \ - SymX(tryPutMVarzh_fast) \ - SymX(tryTakeMVarzh_fast) \ - SymX(unblockAsyncExceptionszh_fast) \ - SymX(unloadObj) \ - SymX(unsafeThawArrayzh_fast) \ - SymX(waitReadzh_fast) \ - SymX(waitWritezh_fast) \ - SymX(word2Integerzh_fast) \ - SymX(writeTVarzh_fast) \ - SymX(xorIntegerzh_fast) \ - SymX(yieldzh_fast) \ - Sym(stg_interp_constr_entry) \ - SymX(allocateExec) \ - SymX(freeExec) \ - SymX(getAllocations) \ - SymX(revertCAFs) \ - SymX(RtsFlags) \ - Sym(rts_breakpoint_io_action) \ - Sym(rts_stop_next_breakpoint) \ - Sym(rts_stop_on_exception) \ - SymX(stopTimer) \ - SymX(n_capabilities) \ - RTS_USER_SIGNALS_SYMBOLS - -#ifdef SUPPORT_LONG_LONGS -#define RTS_LONG_LONG_SYMS \ - SymX(int64ToIntegerzh_fast) \ - SymX(word64ToIntegerzh_fast) -#else -#define RTS_LONG_LONG_SYMS /* nothing */ -#endif + +#define RTS_SYMBOLS \ + Maybe_Stable_Names \ + RTS_TICKY_SYMBOLS \ + SymI_HasProto(StgReturn) \ + SymI_HasProto(stg_enter_info) \ + SymI_HasProto(stg_gc_void_info) \ + SymI_HasProto(__stg_gc_enter_1) \ + SymI_HasProto(stg_gc_noregs) \ + SymI_HasProto(stg_gc_unpt_r1_info) \ + SymI_HasProto(stg_gc_unpt_r1) \ + SymI_HasProto(stg_gc_unbx_r1_info) \ + SymI_HasProto(stg_gc_unbx_r1) \ + SymI_HasProto(stg_gc_f1_info) \ + SymI_HasProto(stg_gc_f1) \ + SymI_HasProto(stg_gc_d1_info) \ + SymI_HasProto(stg_gc_d1) \ + SymI_HasProto(stg_gc_l1_info) \ + SymI_HasProto(stg_gc_l1) \ + SymI_HasProto(__stg_gc_fun) \ + SymI_HasProto(stg_gc_fun_info) \ + SymI_HasProto(stg_gc_gen) \ + SymI_HasProto(stg_gc_gen_info) \ + SymI_HasProto(stg_gc_gen_hp) \ + SymI_HasProto(stg_gc_ut) \ + SymI_HasProto(stg_gen_yield) \ + SymI_HasProto(stg_yield_noregs) \ + SymI_HasProto(stg_yield_to_interpreter) \ + SymI_HasProto(stg_gen_block) \ + SymI_HasProto(stg_block_noregs) \ + SymI_HasProto(stg_block_1) \ + SymI_HasProto(stg_block_takemvar) \ + SymI_HasProto(stg_block_putmvar) \ + MAIN_CAP_SYM \ + SymI_HasProto(MallocFailHook) \ + SymI_HasProto(OnExitHook) \ + SymI_HasProto(OutOfHeapHook) \ + SymI_HasProto(StackOverflowHook) \ + SymI_HasProto(addDLL) \ + SymI_HasProto(__int_encodeDouble) \ + SymI_HasProto(__word_encodeDouble) \ + SymI_HasProto(__2Int_encodeDouble) \ + SymI_HasProto(__int_encodeFloat) \ + SymI_HasProto(__word_encodeFloat) \ + SymI_HasProto(stg_atomicallyzh) \ + SymI_HasProto(barf) \ + SymI_HasProto(debugBelch) \ + SymI_HasProto(errorBelch) \ + SymI_HasProto(sysErrorBelch) \ + SymI_HasProto(stg_getMaskingStatezh) \ + SymI_HasProto(stg_maskAsyncExceptionszh) \ + SymI_HasProto(stg_maskUninterruptiblezh) \ + SymI_HasProto(stg_catchzh) \ + SymI_HasProto(stg_catchRetryzh) \ + SymI_HasProto(stg_catchSTMzh) \ + SymI_HasProto(stg_checkzh) \ + SymI_HasProto(closure_flags) \ + SymI_HasProto(cmp_thread) \ + SymI_HasProto(createAdjustor) \ + SymI_HasProto(stg_decodeDoublezu2Intzh) \ + SymI_HasProto(stg_decodeFloatzuIntzh) \ + SymI_HasProto(defaultsHook) \ + SymI_HasProto(stg_delayzh) \ + SymI_HasProto(stg_deRefWeakzh) \ + SymI_HasProto(stg_deRefStablePtrzh) \ + SymI_HasProto(dirty_MUT_VAR) \ + SymI_HasProto(stg_forkzh) \ + SymI_HasProto(stg_forkOnzh) \ + SymI_HasProto(forkProcess) \ + SymI_HasProto(forkOS_createThread) \ + SymI_HasProto(freeHaskellFunctionPtr) \ + SymI_HasProto(getOrSetTypeableStore) \ + SymI_HasProto(getOrSetGHCConcSignalSignalHandlerStore) \ + SymI_HasProto(getOrSetGHCConcWindowsPendingDelaysStore) \ + SymI_HasProto(getOrSetGHCConcWindowsIOManagerThreadStore) \ + SymI_HasProto(getOrSetGHCConcWindowsProddingStore) \ + SymI_HasProto(getOrSetSystemEventThreadEventManagerStore) \ + SymI_HasProto(getOrSetSystemEventThreadIOManagerThreadStore) \ + SymI_HasProto(genSymZh) \ + SymI_HasProto(genericRaise) \ + SymI_HasProto(getProgArgv) \ + SymI_HasProto(getFullProgArgv) \ + SymI_HasProto(getStablePtr) \ + SymI_HasProto(hs_init) \ + SymI_HasProto(hs_exit) \ + SymI_HasProto(hs_set_argv) \ + SymI_HasProto(hs_add_root) \ + SymI_HasProto(hs_perform_gc) \ + SymI_HasProto(hs_free_stable_ptr) \ + SymI_HasProto(hs_free_fun_ptr) \ + SymI_HasProto(hs_hpc_rootModule) \ + SymI_HasProto(hs_hpc_module) \ + SymI_HasProto(initLinker) \ + SymI_HasProto(stg_unpackClosurezh) \ + SymI_HasProto(stg_getApStackValzh) \ + SymI_HasProto(stg_getSparkzh) \ + SymI_HasProto(stg_numSparkszh) \ + SymI_HasProto(stg_isCurrentThreadBoundzh) \ + SymI_HasProto(stg_isEmptyMVarzh) \ + SymI_HasProto(stg_killThreadzh) \ + SymI_HasProto(loadArchive) \ + SymI_HasProto(loadObj) \ + SymI_HasProto(insertStableSymbol) \ + SymI_HasProto(insertSymbol) \ + SymI_HasProto(lookupSymbol) \ + SymI_HasProto(stg_makeStablePtrzh) \ + SymI_HasProto(stg_mkApUpd0zh) \ + SymI_HasProto(stg_myThreadIdzh) \ + SymI_HasProto(stg_labelThreadzh) \ + SymI_HasProto(stg_newArrayzh) \ + SymI_HasProto(stg_newBCOzh) \ + SymI_HasProto(stg_newByteArrayzh) \ + SymI_HasProto_redirect(newCAF, newDynCAF) \ + SymI_HasProto(stg_newMVarzh) \ + SymI_HasProto(stg_newMutVarzh) \ + SymI_HasProto(stg_newTVarzh) \ + SymI_HasProto(stg_noDuplicatezh) \ + SymI_HasProto(stg_atomicModifyMutVarzh) \ + SymI_HasProto(stg_newPinnedByteArrayzh) \ + SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \ + SymI_HasProto(newSpark) \ + SymI_HasProto(performGC) \ + SymI_HasProto(performMajorGC) \ + SymI_HasProto(prog_argc) \ + SymI_HasProto(prog_argv) \ + SymI_HasProto(stg_putMVarzh) \ + SymI_HasProto(stg_raisezh) \ + SymI_HasProto(stg_raiseIOzh) \ + SymI_HasProto(stg_readTVarzh) \ + SymI_HasProto(stg_readTVarIOzh) \ + SymI_HasProto(resumeThread) \ + SymI_HasProto(resolveObjs) \ + SymI_HasProto(stg_retryzh) \ + SymI_HasProto(rts_apply) \ + SymI_HasProto(rts_checkSchedStatus) \ + SymI_HasProto(rts_eval) \ + SymI_HasProto(rts_evalIO) \ + SymI_HasProto(rts_evalLazyIO) \ + SymI_HasProto(rts_evalStableIO) \ + SymI_HasProto(rts_eval_) \ + SymI_HasProto(rts_getBool) \ + SymI_HasProto(rts_getChar) \ + SymI_HasProto(rts_getDouble) \ + SymI_HasProto(rts_getFloat) \ + SymI_HasProto(rts_getInt) \ + SymI_HasProto(rts_getInt8) \ + SymI_HasProto(rts_getInt16) \ + SymI_HasProto(rts_getInt32) \ + SymI_HasProto(rts_getInt64) \ + SymI_HasProto(rts_getPtr) \ + SymI_HasProto(rts_getFunPtr) \ + SymI_HasProto(rts_getStablePtr) \ + SymI_HasProto(rts_getThreadId) \ + SymI_HasProto(rts_getWord) \ + SymI_HasProto(rts_getWord8) \ + SymI_HasProto(rts_getWord16) \ + SymI_HasProto(rts_getWord32) \ + SymI_HasProto(rts_getWord64) \ + SymI_HasProto(rts_lock) \ + SymI_HasProto(rts_mkBool) \ + SymI_HasProto(rts_mkChar) \ + SymI_HasProto(rts_mkDouble) \ + SymI_HasProto(rts_mkFloat) \ + SymI_HasProto(rts_mkInt) \ + SymI_HasProto(rts_mkInt8) \ + SymI_HasProto(rts_mkInt16) \ + SymI_HasProto(rts_mkInt32) \ + SymI_HasProto(rts_mkInt64) \ + SymI_HasProto(rts_mkPtr) \ + SymI_HasProto(rts_mkFunPtr) \ + SymI_HasProto(rts_mkStablePtr) \ + SymI_HasProto(rts_mkString) \ + SymI_HasProto(rts_mkWord) \ + SymI_HasProto(rts_mkWord8) \ + SymI_HasProto(rts_mkWord16) \ + SymI_HasProto(rts_mkWord32) \ + SymI_HasProto(rts_mkWord64) \ + SymI_HasProto(rts_unlock) \ + SymI_HasProto(rts_unsafeGetMyCapability) \ + SymI_HasProto(rtsSupportsBoundThreads) \ + SymI_HasProto(rts_isProfiled) \ + SymI_HasProto(setProgArgv) \ + SymI_HasProto(startupHaskell) \ + SymI_HasProto(shutdownHaskell) \ + SymI_HasProto(shutdownHaskellAndExit) \ + SymI_HasProto(stable_ptr_table) \ + SymI_HasProto(stackOverflow) \ + SymI_HasProto(stg_CAF_BLACKHOLE_info) \ + SymI_HasProto(stg_BLACKHOLE_info) \ + SymI_HasProto(__stg_EAGER_BLACKHOLE_info) \ + SymI_HasProto(stg_BLOCKING_QUEUE_CLEAN_info) \ + SymI_HasProto(stg_BLOCKING_QUEUE_DIRTY_info) \ + SymI_HasProto(startTimer) \ + SymI_HasProto(stg_MVAR_CLEAN_info) \ + SymI_HasProto(stg_MVAR_DIRTY_info) \ + SymI_HasProto(stg_IND_STATIC_info) \ + SymI_HasProto(stg_ARR_WORDS_info) \ + SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info) \ + SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info) \ + SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN0_info) \ + SymI_HasProto(stg_WEAK_info) \ + SymI_HasProto(stg_ap_v_info) \ + SymI_HasProto(stg_ap_f_info) \ + SymI_HasProto(stg_ap_d_info) \ + SymI_HasProto(stg_ap_l_info) \ + SymI_HasProto(stg_ap_n_info) \ + SymI_HasProto(stg_ap_p_info) \ + SymI_HasProto(stg_ap_pv_info) \ + SymI_HasProto(stg_ap_pp_info) \ + SymI_HasProto(stg_ap_ppv_info) \ + SymI_HasProto(stg_ap_ppp_info) \ + SymI_HasProto(stg_ap_pppv_info) \ + SymI_HasProto(stg_ap_pppp_info) \ + SymI_HasProto(stg_ap_ppppp_info) \ + SymI_HasProto(stg_ap_pppppp_info) \ + SymI_HasProto(stg_ap_0_fast) \ + SymI_HasProto(stg_ap_v_fast) \ + SymI_HasProto(stg_ap_f_fast) \ + SymI_HasProto(stg_ap_d_fast) \ + SymI_HasProto(stg_ap_l_fast) \ + SymI_HasProto(stg_ap_n_fast) \ + SymI_HasProto(stg_ap_p_fast) \ + SymI_HasProto(stg_ap_pv_fast) \ + SymI_HasProto(stg_ap_pp_fast) \ + SymI_HasProto(stg_ap_ppv_fast) \ + SymI_HasProto(stg_ap_ppp_fast) \ + SymI_HasProto(stg_ap_pppv_fast) \ + SymI_HasProto(stg_ap_pppp_fast) \ + SymI_HasProto(stg_ap_ppppp_fast) \ + SymI_HasProto(stg_ap_pppppp_fast) \ + SymI_HasProto(stg_ap_1_upd_info) \ + SymI_HasProto(stg_ap_2_upd_info) \ + SymI_HasProto(stg_ap_3_upd_info) \ + SymI_HasProto(stg_ap_4_upd_info) \ + SymI_HasProto(stg_ap_5_upd_info) \ + SymI_HasProto(stg_ap_6_upd_info) \ + SymI_HasProto(stg_ap_7_upd_info) \ + SymI_HasProto(stg_exit) \ + SymI_HasProto(stg_sel_0_upd_info) \ + SymI_HasProto(stg_sel_10_upd_info) \ + SymI_HasProto(stg_sel_11_upd_info) \ + SymI_HasProto(stg_sel_12_upd_info) \ + SymI_HasProto(stg_sel_13_upd_info) \ + SymI_HasProto(stg_sel_14_upd_info) \ + SymI_HasProto(stg_sel_15_upd_info) \ + SymI_HasProto(stg_sel_1_upd_info) \ + SymI_HasProto(stg_sel_2_upd_info) \ + SymI_HasProto(stg_sel_3_upd_info) \ + SymI_HasProto(stg_sel_4_upd_info) \ + SymI_HasProto(stg_sel_5_upd_info) \ + SymI_HasProto(stg_sel_6_upd_info) \ + SymI_HasProto(stg_sel_7_upd_info) \ + SymI_HasProto(stg_sel_8_upd_info) \ + SymI_HasProto(stg_sel_9_upd_info) \ + SymI_HasProto(stg_upd_frame_info) \ + SymI_HasProto(stg_bh_upd_frame_info) \ + SymI_HasProto(suspendThread) \ + SymI_HasProto(stg_takeMVarzh) \ + SymI_HasProto(stg_threadStatuszh) \ + SymI_HasProto(stg_tryPutMVarzh) \ + SymI_HasProto(stg_tryTakeMVarzh) \ + SymI_HasProto(stg_unmaskAsyncExceptionszh) \ + SymI_HasProto(unloadObj) \ + SymI_HasProto(stg_unsafeThawArrayzh) \ + SymI_HasProto(stg_waitReadzh) \ + SymI_HasProto(stg_waitWritezh) \ + SymI_HasProto(stg_writeTVarzh) \ + SymI_HasProto(stg_yieldzh) \ + SymI_NeedsProto(stg_interp_constr_entry) \ + SymI_HasProto(stg_arg_bitmaps) \ + SymI_HasProto(alloc_blocks_lim) \ + SymI_HasProto(g0) \ + SymI_HasProto(allocate) \ + SymI_HasProto(allocateExec) \ + SymI_HasProto(freeExec) \ + SymI_HasProto(getAllocations) \ + SymI_HasProto(revertCAFs) \ + SymI_HasProto(RtsFlags) \ + SymI_NeedsProto(rts_breakpoint_io_action) \ + SymI_NeedsProto(rts_stop_next_breakpoint) \ + SymI_NeedsProto(rts_stop_on_exception) \ + SymI_HasProto(stopTimer) \ + SymI_HasProto(n_capabilities) \ + SymI_HasProto(stg_traceCcszh) \ + SymI_HasProto(stg_traceEventzh) \ + RTS_USER_SIGNALS_SYMBOLS \ + RTS_INTCHAR_SYMBOLS + // 64-bit support functions in libgcc.a #if defined(__GNUC__) && SIZEOF_VOID_P <= 4 -#define RTS_LIBGCC_SYMBOLS \ - Sym(__divdi3) \ - Sym(__udivdi3) \ - Sym(__moddi3) \ - Sym(__umoddi3) \ - Sym(__muldi3) \ - Sym(__ashldi3) \ - Sym(__ashrdi3) \ - Sym(__lshrdi3) \ - Sym(__eprintf) -#elif defined(ia64_HOST_ARCH) -#define RTS_LIBGCC_SYMBOLS \ - Sym(__divdi3) \ - Sym(__udivdi3) \ - Sym(__moddi3) \ - Sym(__umoddi3) \ - Sym(__divsf3) \ - Sym(__divdf3) +#define RTS_LIBGCC_SYMBOLS \ + SymI_NeedsProto(__divdi3) \ + SymI_NeedsProto(__udivdi3) \ + SymI_NeedsProto(__moddi3) \ + SymI_NeedsProto(__umoddi3) \ + SymI_NeedsProto(__muldi3) \ + SymI_NeedsProto(__ashldi3) \ + SymI_NeedsProto(__ashrdi3) \ + SymI_NeedsProto(__lshrdi3) #else #define RTS_LIBGCC_SYMBOLS #endif @@ -833,32 +1009,34 @@ typedef struct _RtsSymbolVal { // on Mac OS X. They have to receive special treatment, // see machoInitSymbolsWithoutUnderscore() #define RTS_MACHO_NOUNDERLINE_SYMBOLS \ - Sym(saveFP) \ - Sym(restFP) + SymI_NeedsProto(saveFP) \ + SymI_NeedsProto(restFP) #endif /* entirely bogus claims about types of these symbols */ -#define Sym(vvv) extern void vvv(void); -#if defined(__PIC__) && defined(mingw32_TARGET_OS) -#define SymExtern(vvv) extern void _imp__ ## vvv (void); +#define SymI_NeedsProto(vvv) extern void vvv(void); +#if defined(__PIC__) && defined(mingw32_HOST_OS) +#define SymE_HasProto(vvv) SymE_HasProto(vvv); +#define SymE_NeedsProto(vvv) extern void _imp__ ## vvv (void); #else -#define SymExtern(vvv) SymX(vvv) +#define SymE_NeedsProto(vvv) SymI_NeedsProto(vvv); +#define SymE_HasProto(vvv) SymI_HasProto(vvv) #endif -#define SymX(vvv) /**/ -#define SymX_redirect(vvv,xxx) /**/ +#define SymI_HasProto(vvv) /**/ +#define SymI_HasProto_redirect(vvv,xxx) /**/ RTS_SYMBOLS RTS_RET_SYMBOLS -RTS_LONG_LONG_SYMS RTS_POSIX_ONLY_SYMBOLS RTS_MINGW_ONLY_SYMBOLS RTS_CYGWIN_ONLY_SYMBOLS RTS_DARWIN_ONLY_SYMBOLS RTS_LIBGCC_SYMBOLS RTS_LIBFFI_SYMBOLS -#undef Sym -#undef SymX -#undef SymX_redirect -#undef SymExtern +#undef SymI_NeedsProto +#undef SymI_HasProto +#undef SymI_HasProto_redirect +#undef SymE_HasProto +#undef SymE_NeedsProto #ifdef LEADING_UNDERSCORE #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s) @@ -866,22 +1044,23 @@ RTS_LIBFFI_SYMBOLS #define MAYBE_LEADING_UNDERSCORE_STR(s) (s) #endif -#define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ +#define SymI_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ (void*)(&(vvv)) }, -#define SymX(vvv) Sym(vvv) -#define SymExtern(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ +#define SymE_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ (void*)DLL_IMPORT_DATA_REF(vvv) }, -// SymX_redirect allows us to redirect references to one symbol to +#define SymI_NeedsProto(vvv) SymI_HasProto(vvv) +#define SymE_NeedsProto(vvv) SymE_HasProto(vvv) + +// SymI_HasProto_redirect allows us to redirect references to one symbol to // another symbol. See newCAF/newDynCAF for an example. -#define SymX_redirect(vvv,xxx) \ +#define SymI_HasProto_redirect(vvv,xxx) \ { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ (void*)(&(xxx)) }, static RtsSymbolVal rtsSyms[] = { RTS_SYMBOLS RTS_RET_SYMBOLS - RTS_LONG_LONG_SYMS RTS_POSIX_ONLY_SYMBOLS RTS_MINGW_ONLY_SYMBOLS RTS_CYGWIN_ONLY_SYMBOLS @@ -941,20 +1120,36 @@ static int linker_init_done = 0 ; #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(); @@ -962,6 +1157,7 @@ initLinker( void ) 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(); @@ -973,7 +1169,49 @@ initLinker( void ) # 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(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; + } +#endif + +#if defined(mingw32_HOST_OS) + /* + * These two libraries cause problems when added to the static link, + * but are necessary for resolving symbols in GHCi, hence we load + * them manually here. + */ + 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 } /* ----------------------------------------------------------------------------- @@ -1011,29 +1249,113 @@ typedef 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 ------------------- */ @@ -1091,16 +1413,17 @@ addDLL( char *dll_name ) opened_dlls = o_dll; return NULL; -# else - barf("addDLL: not implemented on this platform"); -# endif error: stgFree(buf); sysErrorBelch(dll_name); - + /* LoadLibrary failed; return a ptr to the error msg. */ return "addDLL: could not load DLL"; + +# else + barf("addDLL: not implemented on this platform"); +# endif } /* ----------------------------------------------------------------------------- @@ -1130,11 +1453,13 @@ void * lookupSymbol( char *lbl ) { void *val; + IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl)); initLinker() ; ASSERT(symhash != NULL); val = lookupStrHashTable(symhash, lbl); if (val == NULL) { + IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n")); # if defined(OBJFORMAT_ELF) return dlsym(dl_prog_handle, lbl); # elif defined(OBJFORMAT_MACHO) @@ -1147,6 +1472,7 @@ lookupSymbol( char *lbl ) symbol name. For now, we simply strip it off here (and ONLY here). */ + IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n", lbl)); ASSERT(lbl[0] == '_'); return dlsym(dl_prog_handle, lbl+1); # else @@ -1158,34 +1484,24 @@ lookupSymbol( char *lbl ) } # endif /* HAVE_DLFCN_H */ # elif defined(OBJFORMAT_PEi386) - OpenedDLL* o_dll; void* sym; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("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) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } - } - sym = GetProcAddress(o_dll->instance, lbl); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; - } - } + + 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 ( (unsigned char*)lbl ); + sym = lookupSymbolInDLLs((unsigned char*)lbl); + if (sym != NULL) { return sym; }; return NULL; + # else ASSERT(2+2 == 5); return NULL; # endif } else { + IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p\n", lbl, val)); return val; } } @@ -1226,8 +1542,286 @@ void ghci_enquire ( char* addr ) } #endif -#ifdef ia64_HOST_ARCH -static unsigned int PLTSize(void); +#ifdef USE_MMAP +#define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1)) + +static void * +mmapForLinker (size_t bytes, nat flags, int fd) +{ + void *map_addr = NULL; + void *result; + int pagesize, size; + static nat fixed = 0; + + pagesize = getpagesize(); + size = ROUND_UP(bytes, pagesize); + +#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH) +mmap_again: + + if (mmap_32bit_base != 0) { + map_addr = mmap_32bit_base; + } +#endif + + result = mmap(map_addr, size, PROT_EXEC|PROT_READ|PROT_WRITE, + MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, 0); + + if (result == MAP_FAILED) { + sysErrorBelch("mmap %lu bytes at %p",(lnat)size,map_addr); + errorBelch("Try specifying an address with +RTS -xm -RTS"); + stg_exit(EXIT_FAILURE); + } + +#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH) + if (mmap_32bit_base != 0) { + if (result == map_addr) { + mmap_32bit_base = (StgWord8*)map_addr + size; + } else { + if ((W_)result > 0x80000000) { + // oops, we were given memory over 2Gb +#if defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) + // Some platforms require MAP_FIXED. This is normally + // a bad idea, because MAP_FIXED will overwrite + // existing mappings. + munmap(result,size); + fixed = MAP_FIXED; + goto mmap_again; +#else + barf("loadObj: failed to mmap() memory below 2Gb; asked for %lu bytes at %p. Try specifying an address with +RTS -xm -RTS", size, map_addr, result); +#endif + } else { + // hmm, we were given memory somewhere else, but it's + // still under 2Gb so we can use it. Next time, ask + // for memory right after the place we just got some + mmap_32bit_base = (StgWord8*)result + size; + } + } + } else { + if ((W_)result > 0x80000000) { + // oops, we were given memory over 2Gb + // ... try allocating memory somewhere else?; + debugTrace(DEBUG_linker,"MAP_32BIT didn't work; gave us %lu bytes at 0x%p", bytes, result); + munmap(result, size); + + // Set a base address and try again... (guess: 1Gb) + mmap_32bit_base = (void*)0x40000000; + goto mmap_again; + } + } +#endif + + return result; +} +#endif // USE_MMAP + +static ObjectCode* +mkOc( char *path, char *image, int imageSize, + char *archiveMemberName +#ifndef USE_MMAP +#ifdef darwin_HOST_OS + , int misalignment +#endif +#endif + ) { + ObjectCode* oc; + + 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; +} + +#if defined(USE_ARCHIVES_FOR_GHCI) +HsInt +loadArchive( char *path ) +{ + ObjectCode* oc; + char *image; + int imageSize; + FILE *f; + int n; + size_t fileNameSize; + char *file; + size_t fileSize; + int isObject; + char tmp[12]; + + IF_DEBUG(linker, debugBelch("loadArchive `%s'\n", path)); + + fileSize = 32; + file = stgMallocBytes(fileSize, "loadArchive(file)"); + + f = fopen(path, "rb"); + if (!f) + barf("loadObj: can't read `%s'", path); + + n = fread ( tmp, 1, 8, f ); + if (strncmp(tmp, "!\n", 8) != 0) + barf("loadArchive: Not an archive: `%s'", path); + + while(1) { + n = fread ( file, 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'; + imageSize = 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]); + + /* Check for BSD-variant large filenames */ + if (0 == strncmp(file, "#1/", 3)) { + file[16] = '\0'; + for (n = 3; isdigit(file[n]); n++); + file[n] = '\0'; + fileNameSize = atoi(file + 3); + imageSize -= fileNameSize; + if (fileNameSize > fileSize) { + /* Double it to avoid potentially continually + increasing it by 1 */ + fileSize = fileNameSize * 2; + file = stgReallocBytes(file, fileSize, "loadArchive(file)"); + } + n = fread ( file, 1, fileNameSize, f ); + if (n != (int)fileNameSize) + barf("loadArchive: Failed reading filename from `%s'", path); + } + else { + fileNameSize = 16; + } + + isObject = 0; + for (n = 0; n < (int)fileNameSize - 1; n++) { + if ((file[n] == '.') && (file[n + 1] == 'o')) { + isObject = 1; + break; + } + } + + if (isObject) { + char *archiveMemberName; + + /* 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, and if we malloc the + memory then we can be given memory above 2^32, so we + mmap some anonymous memory and use that. We could + do better here. */ + image = mmapForLinker(imageSize, MAP_ANONYMOUS, -1); + n = fread ( image, 1, imageSize, f ); + if (n != imageSize) + barf("loadObj: error whilst reading `%s'", path); + + archiveMemberName = stgMallocBytes(strlen(path) + fileNameSize + 3, "loadArchive(file)"); + sprintf(archiveMemberName, "%s(%.*s)", path, (int)fileNameSize, file); + + oc = mkOc(path, image, imageSize, archiveMemberName +#ifndef USE_MMAP +#ifdef darwin_HOST_OS + , 0 +#endif +#endif + ); + + stgFree(archiveMemberName); + + if (0 == loadOc(oc)) { + stgFree(file); + return 0; + } + } + else { + n = fseek(f, imageSize, SEEK_CUR); + if (n != 0) + barf("loadArchive: error whilst seeking by %d in `%s'", + imageSize, path); + } + /* .ar files are 2-byte aligned */ + if (imageSize % 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(file); + return 1; +} +#else +HsInt GNU_ATTRIBUTE(__noreturn__) +loadArchive( char *path STG_UNUSED ) { + barf("loadArchive: not enabled"); +} #endif /* ----------------------------------------------------------------------------- @@ -1239,14 +1833,17 @@ HsInt loadObj( char *path ) { ObjectCode* oc; + char *image; + int fileSize; struct stat st; - int r, n; + int r; #ifdef USE_MMAP - int fd, pagesize; - void *map_addr = NULL; + int fd; #else FILE *f; #endif + IF_DEBUG(linker, debugBelch("loadObj %s\n", path)); + initLinker(); /* debugBelch("loadObj %s\n", path ); */ @@ -1273,38 +1870,15 @@ loadObj( char *path ) } } - oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)"); - -# if defined(OBJFORMAT_ELF) - oc->formatName = "ELF"; -# elif defined(OBJFORMAT_PEi386) - oc->formatName = "PEi386"; -# elif defined(OBJFORMAT_MACHO) - oc->formatName = "Mach-O"; -# else - stgFree(oc); - barf("loadObj: not implemented on this platform"); -# endif - r = stat(path, &st); - if (r == -1) { return 0; } - - /* sigh, strdup() isn't a POSIX function, so do it the long way */ - oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" ); - strcpy(oc->fileName, path); - - oc->fileSize = st.st_size; - oc->symbols = NULL; - oc->sections = NULL; - oc->proddables = NULL; + if (r == -1) { + IF_DEBUG(linker, debugBelch("File doesn't exist\n")); + return 0; + } - /* chain it onto the list of objects */ - oc->next = objects; - objects = oc; + fileSize = st.st_size; #ifdef USE_MMAP -#define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1)) - /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */ #if defined(openbsd_HOST_OS) @@ -1315,47 +1889,11 @@ loadObj( char *path ) if (fd == -1) barf("loadObj: can't open `%s'", path); - pagesize = getpagesize(); - -#ifdef ia64_HOST_ARCH - /* The PLT needs to be right before the object */ - n = ROUND_UP(PLTSize(), pagesize); - oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0); - if (oc->plt == MAP_FAILED) - barf("loadObj: can't allocate PLT"); - - oc->pltIndex = 0; - map_addr = oc->plt + n; -#endif - - n = ROUND_UP(oc->fileSize, pagesize); - - /* Link objects into the lower 2Gb on x86_64. GHC assumes the - * small memory model on this architecture (see gcc docs, - * -mcmodel=small). - * - * MAP_32BIT not available on OpenBSD/amd64 - */ -#if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT) -#define EXTRA_MAP_FLAGS MAP_32BIT -#else -#define EXTRA_MAP_FLAGS 0 -#endif - - /* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */ -#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) -#define MAP_ANONYMOUS MAP_ANON -#endif - - oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, - MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0); - if (oc->image == MAP_FAILED) - barf("loadObj: can't map `%s'", path); + image = mmapForLinker(fileSize, 0, fd); close(fd); #else /* !USE_MMAP */ - /* load the image into memory */ f = fopen(path, "rb"); if (!f) @@ -1364,7 +1902,7 @@ loadObj( char *path ) # if defined(mingw32_HOST_OS) // TODO: We would like to use allocateExec here, but allocateExec // cannot currently allocate blocks large enough. - oc->image = VirtualAlloc(NULL, oc->fileSize, MEM_RESERVE | MEM_COMMIT, + 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 @@ -1374,28 +1912,53 @@ loadObj( char *path ) // as SSE (used by gcc for floating point) and Altivec require // 16-byte alignment. // We calculate the correct alignment from the header before - // reading the file, and then we misalign oc->image on purpose so + // reading the file, and then we misalign image on purpose so // that the actual sections end up aligned again. - oc->misalignment = machoGetMisalignment(f); - oc->image = stgMallocBytes(oc->fileSize + oc->misalignment, "loadObj(image)"); - oc->image += oc->misalignment; + misalignment = machoGetMisalignment(f); + image = stgMallocBytes(fileSize + misalignment, "loadObj(image)"); + image += misalignment; # else - oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)"); + image = stgMallocBytes(fileSize, "loadObj(image)"); # endif - n = fread ( oc->image, 1, oc->fileSize, f ); - if (n != oc->fileSize) - barf("loadObj: error whilst reading `%s'", path); - + { + int n; + 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 */ @@ -1408,7 +1971,10 @@ loadObj( char *path ) # 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) @@ -1420,10 +1986,14 @@ loadObj( char *path ) # 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; } @@ -1439,6 +2009,7 @@ resolveObjs( void ) ObjectCode *oc; int r; + IF_DEBUG(linker, debugBelch("resolveObjs: start\n")); initLinker(); for (oc = objects; oc; oc = oc->next) { @@ -1456,6 +2027,7 @@ resolveObjs( void ) oc->status = OBJECT_RESOLVED; } } + IF_DEBUG(linker, debugBelch("resolveObjs: done\n")); return 1; } @@ -1466,6 +2038,7 @@ HsInt unloadObj( char *path ) { ObjectCode *oc, *prev; + HsBool unloadedAnyObj = HS_BOOL_FALSE; ASSERT(symhash != NULL); ASSERT(objects != NULL); @@ -1505,12 +2078,20 @@ unloadObj( char *path ) 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; + } } /* ----------------------------------------------------------------------------- @@ -1522,7 +2103,7 @@ static void addProddableBlock ( ObjectCode* oc, void* start, int size ) { ProddableBlock* pb = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock"); - /* debugBelch("aPB %p %p %d\n", oc, start, size); */ + IF_DEBUG(linker, debugBelch("addProddableBlock %p %p %d\n", oc, start, size)); ASSERT(size > 0); pb->start = start; pb->size = size; @@ -1612,47 +2193,23 @@ static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first ) aligned = (oc->fileSize + 3) & ~3; #ifdef USE_MMAP - #ifndef linux_HOST_OS /* mremap is a linux extension */ - #error ocAllocateSymbolExtras doesnt want USE_MMAP to be defined - #endif - pagesize = getpagesize(); n = ROUND_UP( oc->fileSize, pagesize ); m = ROUND_UP( aligned + sizeof (SymbolExtra) * count, pagesize ); - /* If we have a half-page-size file and map one page of it then - * the part of the page after the size of the file remains accessible. - * If, however, we map in 2 pages, the 2nd page is not accessible - * and will give a "Bus Error" on access. To get around this, we check - * if we need any extra pages for the jump islands and map them in - * anonymously. We must check that we actually require extra pages - * otherwise the attempt to mmap 0 pages of anonymous memory will - * fail -EINVAL. + /* we try to use spare space at the end of the last page of the + * image for the jump islands, but if there isn't enough space + * then we have to map some (anonymously, remembering MAP_32BIT). */ - - if( m > n ) + if( m > n ) // we need to allocate more pages { - /* The effect of this mremap() call is only the ensure that we have - * a sufficient number of virtually contiguous pages. As returned from - * mremap, the pages past the end of the file are not backed. We give - * them a backing by using MAP_FIXED to map in anonymous pages. - */ - oc->image = mremap( oc->image, n, m, MREMAP_MAYMOVE ); - - if( oc->image == MAP_FAILED ) - { - errorBelch( "Unable to mremap for Jump Islands\n" ); - return 0; - } - - if( mmap( oc->image + n, m - n, PROT_READ | PROT_WRITE | PROT_EXEC, - MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, 0, 0 ) == MAP_FAILED ) - { - errorBelch( "Unable to mmap( MAP_FIXED ) for Jump Islands\n" ); - return 0; - } + oc->symbol_extras = mmapForLinker(sizeof(SymbolExtra) * count, + MAP_ANONYMOUS, -1); + } + else + { + oc->symbol_extras = (SymbolExtra *) (oc->image + aligned); } - #else oc->image -= misalignment; oc->image = stgReallocBytes( oc->image, @@ -1660,9 +2217,10 @@ static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first ) aligned + sizeof (SymbolExtra) * count, "ocAllocateSymbolExtras" ); oc->image += misalignment; -#endif /* USE_MMAP */ oc->symbol_extras = (SymbolExtra *) (oc->image + aligned); +#endif /* USE_MMAP */ + memset( oc->symbol_extras, 0, sizeof (SymbolExtra) * count ); } else @@ -1716,7 +2274,7 @@ static SymbolExtra* makeSymbolExtra( ObjectCode* oc, * PowerPC specifics (instruction cache flushing) * ------------------------------------------------------------------------*/ -#ifdef powerpc_TARGET_ARCH +#ifdef powerpc_HOST_ARCH /* ocFlushInstructionCache @@ -1917,7 +2475,7 @@ copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize ) { 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; @@ -1948,19 +2506,46 @@ cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab ) */ if (name[7]==0) return name; /* The annoying case: 8 bytes. Copy into a temporary - (which is never freed ...) + (XXX which is never freed ...) */ newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name"); ASSERT(newstr); - 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 @@ -2003,6 +2588,36 @@ zapTrailingAtSign ( UChar* sym ) # undef my_isdigit } +static void * +lookupSymbolInDLLs ( UChar *lbl ) +{ + OpenedDLL* o_dll; + void *sym; + + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { + /* debugBelch("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, (char*)(lbl+1)); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ + return sym; + } + } + sym = GetProcAddress(o_dll->instance, (char*)lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ + return sym; + } + } + return NULL; +} + static int ocVerifyImage_PEi386 ( ObjectCode* oc ) @@ -2225,7 +2840,16 @@ ocGetNames_PEi386 ( ObjectCode* oc ) 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, @@ -2266,7 +2890,10 @@ ocGetNames_PEi386 ( ObjectCode* oc ) COFF_section* sectab_i = (COFF_section*) myindex ( sizeof_COFF_section, sectab, i ); - IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name )); + + char *secname = cstring_from_section_name(sectab_i->Name, strtab); + + IF_DEBUG(linker, debugBelch("section name = %s\n", secname )); # if 0 /* I'm sure this is the Right Way to do it. However, the @@ -2278,12 +2905,12 @@ ocGetNames_PEi386 ( ObjectCode* oc ) 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); @@ -2296,16 +2923,18 @@ ocGetNames_PEi386 ( ObjectCode* oc ) 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; } @@ -2313,6 +2942,8 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addSection(oc, kind, start, end); addProddableBlock(oc, start, end - start + 1); } + + stgFree(secname); } /* Copy exported symbols into the ObjectCode. */ @@ -2368,8 +2999,8 @@ ocGetNames_PEi386 ( ObjectCode* oc ) 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( @@ -2419,7 +3050,7 @@ ocResolve_PEi386 ( ObjectCode* oc ) /* 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); @@ -2444,12 +3075,20 @@ ocResolve_PEi386 ( ObjectCode* oc ) ((UChar*)(oc->image)) + sectab_i->PointerToRelocations ); + char *secname = cstring_from_section_name(sectab_i->Name, strtab); + /* Ignore sections called which contain stabs debugging information. */ - if (0 == strcmp(".stab", 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 @@ -2521,13 +3160,9 @@ ocResolve_PEi386 ( ObjectCode* oc ) + sym->Value); } else { copyName ( sym->Name, strtab, symbol, 1000-1 ); - S = (UInt32) lookupSymbol( symbol ); - if ((void*)S != NULL) goto foundit; - zapTrailingAtSign ( symbol ); - S = (UInt32) lookupSymbol( symbol ); + S = (UInt32) lookupSymbol( (char*)symbol ); if ((void*)S != NULL) goto foundit; - /* Newline first because the interactive linker has printed "linking..." */ - errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol); + errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol); return 0; foundit:; } @@ -2596,12 +3231,6 @@ ocResolve_PEi386 ( ObjectCode* oc ) #elif defined(x86_64_HOST_ARCH) # define ELF_TARGET_X64_64 # define ELF_64BIT -#elif defined (ia64_HOST_ARCH) -# define ELF_TARGET_IA64 /* Used inside */ -# define ELF_64BIT -# define ELF_FUNCTION_DESC /* calling convention uses function descriptors */ -# define ELF_NEED_GOT /* needs Global Offset Table */ -# define ELF_NEED_PLT /* needs Procedure Linkage Tables */ #endif #if !defined(openbsd_HOST_OS) @@ -2634,10 +3263,18 @@ ocResolve_PEi386 ( ObjectCode* oc ) #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 @@ -2731,30 +3368,6 @@ copyFunctionDesc(Elf_Addr target) #endif #ifdef ELF_NEED_PLT -#ifdef ia64_HOST_ARCH -static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value); -static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc); - -static unsigned char plt_code[] = -{ - /* taken from binutils bfd/elfxx-ia64.c */ - 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */ - 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */ - 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */ - 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */ - 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */ - 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */ -}; - -/* If we can't get to the function descriptor via gp, take a local copy of it */ -#define PLT_RELOC(code, target) { \ - Elf64_Sxword rel_value = target - gp_val; \ - if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \ - ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \ - else \ - ia64_reloc_gprel22((Elf_Addr)code, target); \ - } -#endif typedef struct { unsigned char code[sizeof(plt_code)]; @@ -2812,25 +3425,6 @@ findElfSection ( void* objImage, Elf_Word sh_type ) return ptr; } -#if defined(ia64_HOST_ARCH) -static Elf_Addr -findElfSegment ( void* objImage, Elf_Addr vaddr ) -{ - char* ehdrC = (char*)objImage; - Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC; - Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff); - Elf_Addr segaddr = 0; - int i; - - for (i = 0; i < ehdr->e_phnum; i++) { - segaddr = phdr[i].p_vaddr; - if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz)) - break; - } - return segaddr; -} -#endif - static int ocVerifyImage_ELF ( ObjectCode* oc ) { @@ -3324,9 +3918,6 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, # if defined(sparc_HOST_ARCH) Elf_Word* pP = (Elf_Word*)P; Elf_Word w1, w2; -# elif defined(ia64_HOST_ARCH) - Elf64_Xword *pP = (Elf64_Xword *)P; - Elf_Addr addr; # elif defined(powerpc_HOST_ARCH) Elf_Sword delta; # endif @@ -3403,49 +3994,30 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, 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: + w2 = (Elf_Word)value; + + // SPARC doesn't do misaligned writes of 32 bit words, + // so we have to do this one byte-at-a-time. + char *pPc = (char*)pP; + pPc[0] = (char) ((Elf_Word)(w2 & 0xff000000) >> 24); + pPc[1] = (char) ((Elf_Word)(w2 & 0x00ff0000) >> 16); + pPc[2] = (char) ((Elf_Word)(w2 & 0x0000ff00) >> 8); + pPc[3] = (char) ((Elf_Word)(w2 & 0x000000ff)); + break; + case R_SPARC_32: w2 = (Elf_Word)value; *pP = w2; break; -# elif defined(ia64_HOST_ARCH) - case R_IA64_DIR64LSB: - case R_IA64_FPTR64LSB: - *pP = value; - break; - case R_IA64_PCREL64LSB: - *pP = value - P; - break; - case R_IA64_SEGREL64LSB: - addr = findElfSegment(ehdrC, value); - *pP = value - addr; - break; - case R_IA64_GPREL22: - ia64_reloc_gprel22(P, value); - break; - case R_IA64_LTOFF22: - case R_IA64_LTOFF22X: - case R_IA64_LTOFF_FPTR22: - addr = allocateGOTEntry(value); - ia64_reloc_gprel22(P, addr); - break; - case R_IA64_PCREL21B: - ia64_reloc_pcrel21(P, S, oc); - break; - case R_IA64_LDXMOV: - /* This goes with R_IA64_LTOFF22X and points to the load to - * convert into a move. We don't implement relaxation. */ - break; # elif defined(powerpc_HOST_ARCH) case R_PPC_ADDR16_LO: *(Elf32_Half*) P = value; @@ -3496,6 +4068,9 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, 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 @@ -3508,6 +4083,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, #endif } *(Elf64_Word *)P = (Elf64_Word)off; +#endif break; } @@ -3519,6 +4095,9 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, } 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) @@ -3530,9 +4109,13 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, #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) @@ -3544,6 +4127,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, #endif } *(Elf64_Sword *)P = (Elf64_Sword)value; +#endif break; case R_X86_64_GOTPCREL: @@ -3556,6 +4140,9 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, 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) @@ -3563,6 +4150,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, off = pltAddress + A - P; } *(Elf64_Word *)P = (Elf64_Word)off; +#endif break; } #endif @@ -3621,98 +4209,6 @@ ocResolve_ELF ( ObjectCode* oc ) } /* - * IA64 specifics - * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template - * at the front. The following utility functions pack and unpack instructions, and - * take care of the most common relocations. - */ - -#ifdef ia64_HOST_ARCH - -static Elf64_Xword -ia64_extract_instruction(Elf64_Xword *target) -{ - Elf64_Xword w1, w2; - int slot = (Elf_Addr)target & 3; - target = (Elf_Addr)target & ~3; - - w1 = *target; - w2 = *(target+1); - - switch (slot) - { - case 0: - return ((w1 >> 5) & 0x1ffffffffff); - case 1: - return (w1 >> 46) | ((w2 & 0x7fffff) << 18); - case 2: - return (w2 >> 23); - default: - barf("ia64_extract_instruction: invalid slot %p", target); - } -} - -static void -ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value) -{ - int slot = (Elf_Addr)target & 3; - target = (Elf_Addr)target & ~3; - - switch (slot) - { - case 0: - *target |= value << 5; - break; - case 1: - *target |= value << 46; - *(target+1) |= value >> 18; - break; - case 2: - *(target+1) |= value << 23; - break; - } -} - -static void -ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value) -{ - Elf64_Xword instruction; - Elf64_Sxword rel_value; - - rel_value = value - gp_val; - if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) - barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val); - - instruction = ia64_extract_instruction((Elf64_Xword *)target); - instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */ - | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */ - | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */ - | ((Elf64_Xword)(rel_value < 0) << 36); /* s */ - ia64_deposit_instruction((Elf64_Xword *)target, instruction); -} - -static void -ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc) -{ - Elf64_Xword instruction; - Elf64_Sxword rel_value; - Elf_Addr entry; - - entry = allocatePLTEntry(value, oc); - - rel_value = (entry >> 4) - (target >> 4); - if ((rel_value > 0xfffff) || (rel_value < -0xfffff)) - barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target); - - instruction = ia64_extract_instruction((Elf64_Xword *)target); - instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */ - | ((Elf64_Xword)(rel_value < 0) << 36); /* s */ - ia64_deposit_instruction((Elf64_Xword *)target, instruction); -} - -#endif /* ia64 */ - -/* * PowerPC & X86_64 ELF specifics */ @@ -3849,12 +4345,18 @@ static int ocVerifyImage_MachO(ObjectCode* oc) char *image = (char*) oc->image; struct mach_header *header = (struct mach_header*) image; -#if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH - if(header->magic != MH_MAGIC_64) +#if 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; @@ -3871,6 +4373,8 @@ static int resolveImports( unsigned i; size_t itemSize = 4; + IF_DEBUG(linker, debugBelch("resolveImports: start\n")); + #if i386_HOST_ARCH int isJumpTable = 0; if(!strcmp(sect->sectname,"__jump_table")) @@ -3888,12 +4392,16 @@ static int resolveImports( 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; @@ -3916,6 +4424,7 @@ static int resolveImports( } } + IF_DEBUG(linker, debugBelch("resolveImports: done\n")); return 1; } @@ -3926,9 +4435,11 @@ static unsigned long relocateAddress( unsigned long address) { int i; - for(i = 0; i < nSections; i++) + IF_DEBUG(linker, debugBelch("relocateAddress: start\n")); + for (i = 0; i < nSections; i++) { - if(sections[i].addr <= address + IF_DEBUG(linker, debugBelch(" relocating address in section %d\n", i)); + if (sections[i].addr <= address && address < sections[i].addr + sections[i].size) { return (unsigned long)oc->image @@ -3947,7 +4458,9 @@ static int relocateSection( int nSections, struct section* sections, struct section *sect) { struct relocation_info *relocs; - int i,n; + int i, n; + + IF_DEBUG(linker, debugBelch("relocateSection: start\n")); if(!strcmp(sect->sectname,"__la_symbol_ptr")) return 1; @@ -3959,6 +4472,8 @@ static int relocateSection( return 1; n = sect->nreloc; + IF_DEBUG(linker, debugBelch("relocateSection: number of relocations: %d\n", n)); + relocs = (struct relocation_info*) (image + sect->reloff); for(i=0;ioffset + reloc->r_address; uint64_t thing; - uint64_t value; + /* We shouldn't need to initialise this, but gcc on OS X 64 bit + complains that it may be used uninitialized if we don't */ + uint64_t value = 0; uint64_t baseValue; int type = reloc->r_type; @@ -3994,12 +4511,20 @@ static int relocateSection( 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; } @@ -4007,11 +4532,21 @@ static int relocateSection( { 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 { @@ -4019,8 +4554,10 @@ static int relocateSection( - 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)) { @@ -4039,6 +4576,9 @@ static int relocateSection( 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; @@ -4102,9 +4642,11 @@ static int relocateSection( 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) + else if(scat->r_type == GENERIC_RELOC_SECTDIFF + || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF) #endif { struct scattered_relocation_info *pair = @@ -4160,14 +4702,24 @@ static int relocateSection( } #endif else - continue; // ignore the others + { + barf ("Don't know how to handle this Mach-O " + "scattered relocation entry: " + "object file %s; entry type %ld; " + "address %#lx\n", + OC_INFORMATIVE_FILENAME(oc), + scat->r_type, + scat->r_address); + return 0; + } #ifdef powerpc_HOST_ARCH if(scat->r_type == GENERIC_RELOC_VANILLA || scat->r_type == PPC_RELOC_SECTDIFF) #else if(scat->r_type == GENERIC_RELOC_VANILLA - || scat->r_type == GENERIC_RELOC_SECTDIFF) + || scat->r_type == GENERIC_RELOC_SECTDIFF + || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF) #endif { *wordPtr = word; @@ -4188,11 +4740,32 @@ static int relocateSection( } #endif } + else + { + barf("Can't handle Mach-O scattered relocation entry " + "with this r_length tag: " + "object file %s; entry type %ld; " + "r_length tag %ld; address %#lx\n", + OC_INFORMATIVE_FILENAME(oc), + scat->r_type, + scat->r_length, + scat->r_address); + return 0; + } + } + else /* scat->r_pcrel */ + { + barf("Don't know how to handle *PC-relative* Mach-O " + "scattered relocation entry: " + "object file %s; entry type %ld; address %#lx\n", + OC_INFORMATIVE_FILENAME(oc), + scat->r_type, + scat->r_address); + return 0; } - continue; // FIXME: I hope it's OK to ignore all the others. } - else + else /* !(relocs[i].r_address & R_SCATTERED) */ { struct relocation_info *reloc = &relocs[i]; if(reloc->r_pcrel && !reloc->r_extern) @@ -4237,6 +4810,16 @@ static int relocateSection( word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0); } #endif + else + { + barf("Can't handle this Mach-O relocation entry " + "(not scattered): " + "object file %s; entry type %ld; address %#lx\n", + OC_INFORMATIVE_FILENAME(oc), + reloc->r_type, + reloc->r_address); + return 0; + } if(!reloc->r_extern) { @@ -4308,31 +4891,54 @@ static int relocateSection( } 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; } #endif } - barf("\nunknown relocation %d",reloc->r_type); - return 0; + else + { + 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_INFORMATIVE_FILENAME(oc), + reloc->r_type, + reloc->r_length, + reloc->r_address); + return 0; + } } #endif } + IF_DEBUG(linker, debugBelch("relocateSection: done\n")); return 1; } @@ -4350,6 +4956,8 @@ static int ocGetNames_MachO(ObjectCode* oc) char *commonStorage = NULL; unsigned long commonCounter; + IF_DEBUG(linker,debugBelch("ocGetNames_MachO: start\n")); + for(i=0;incmds;i++) { if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64) @@ -4368,7 +4976,8 @@ static int ocGetNames_MachO(ObjectCode* oc) for(i=0;insects;i++) { - if(sections[i].size == 0) + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: segment %d\n")); + if (sections[i].size == 0) continue; if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL) @@ -4421,6 +5030,7 @@ static int ocGetNames_MachO(ObjectCode* oc) } } } + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: %d external symbols\n", oc->n_symbols)); oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*), "ocGetNames_MachO(oc->symbols)"); @@ -4435,10 +5045,13 @@ static int ocGetNames_MachO(ObjectCode* oc) if(nlist[i].n_type & N_EXT) { char *nm = image + symLC->stroff + nlist[i].n_un.n_strx; - if((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm)) - ; // weak definition, and we already have a definition + if ((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm)) { + // weak definition, and we already have a definition + IF_DEBUG(linker, debugBelch(" weak: %s\n", nm)); + } else { + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting %s\n", nm)); ghciInsertStrHashTable(oc->fileName, symhash, nm, image + sections[nlist[i].n_sect-1].offset @@ -4465,6 +5078,7 @@ static int ocGetNames_MachO(ObjectCode* oc) 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; @@ -4488,7 +5102,8 @@ static int ocResolve_MachO(ObjectCode* oc) struct dysymtab_command *dsymLC = NULL; struct nlist *nlist; - for(i=0;incmds;i++) + IF_DEBUG(linker, debugBelch("ocResolve_MachO: start\n")); + for (i = 0; i < header->ncmds; i++) { if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64) segLC = (struct segment_command*) lc; @@ -4508,7 +5123,8 @@ static int ocResolve_MachO(ObjectCode* oc) unsigned long *indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff); - for(i=0;insects;i++) + IF_DEBUG(linker, debugBelch("ocResolve_MachO: resolving dsymLC\n")); + for (i = 0; i < segLC->nsects; i++) { if( !strcmp(sections[i].sectname,"__la_symbol_ptr") || !strcmp(sections[i].sectname,"__la_sym_ptr2") @@ -4528,12 +5144,18 @@ static int ocResolve_MachO(ObjectCode* oc) if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist)) return 0; } + else + { + IF_DEBUG(linker, debugBelch("ocResolve_MachO: unknown section\n")); + } } } for(i=0;insects;i++) { - if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i])) + IF_DEBUG(linker, debugBelch("ocResolve_MachO: relocating section %d\n", i)); + + if (!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i])) return 0; } @@ -4554,30 +5176,32 @@ static int ocResolve_MachO(ObjectCode* oc) * Yuck. */ +extern void* symbolsWithoutUnderscore[]; + static void machoInitSymbolsWithoutUnderscore() { - extern void* symbolsWithoutUnderscore[]; void **p = symbolsWithoutUnderscore; __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:"); -#undef Sym -#define Sym(x) \ +#undef SymI_NeedsProto +#define SymI_NeedsProto(x) \ __asm__ volatile(".long " # x); RTS_MACHO_NOUNDERLINE_SYMBOLS __asm__ volatile(".text"); -#undef Sym -#define Sym(x) \ +#undef SymI_NeedsProto +#define SymI_NeedsProto(x) \ ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++); RTS_MACHO_NOUNDERLINE_SYMBOLS -#undef Sym +#undef SymI_NeedsProto } #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 @@ -4590,12 +5214,18 @@ static int machoGetMisalignment( FILE * f ) fread(&header, sizeof(header), 1, f); rewind(f); -#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("Bad magic. Expected: %08x, got: %08x.\n", + MH_MAGIC_64, header->magic); return 0; + } #else - if(header.magic != MH_MAGIC) + if(header.magic != MH_MAGIC) { + errorBelch("Bad magic. Expected: %08x, got: %08x.\n", + MH_MAGIC, header->magic); return 0; + } #endif misalignment = (header.sizeofcmds + sizeof(header)) @@ -4603,6 +5233,6 @@ static int machoGetMisalignment( FILE * f ) return misalignment ? (16 - misalignment) : 0; } - #endif +#endif