X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FLinker.c;h=45089e3890a0af28cff9684c3f984f57090c1505;hb=6cf8982ac30be6836a0cdd8be5a6ac1a1a144213;hp=dc31869517712ab2b86eb5a46f9679d059c47553;hpb=7d6dffe542bdad5707a929ae7ac25813c586766d;p=ghc-hetmet.git diff --git a/rts/Linker.c b/rts/Linker.c index dc31869..45089e3 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -18,15 +18,19 @@ #endif #include "Rts.h" -#include "RtsFlags.h" #include "HsFFI.h" + +#include "sm/Storage.h" #include "Hash.h" -#include "Linker.h" #include "LinkerInternals.h" #include "RtsUtils.h" -#include "Schedule.h" -#include "Sparks.h" -#include "RtsTypeable.h" +#include "Trace.h" +#include "StgPrimFloat.h" // for __int_encodeFloat etc. +#include "Stable.h" + +#if !defined(mingw32_HOST_OS) +#include "posix/Signals.h" +#endif #ifdef HAVE_SYS_TYPES_H #include @@ -59,12 +63,12 @@ #include #endif -#if defined(ia64_HOST_ARCH) || defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) +#if defined(ia64_HOST_ARCH) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS) #define USE_MMAP #include #include -#if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) +#if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS) #ifdef HAVE_UNISTD_H #include #endif @@ -83,10 +87,15 @@ # include # include # include +#if !defined(HAVE_DLFCN_H) # include +#endif #if defined(powerpc_HOST_ARCH) # include #endif +#if defined(x86_64_HOST_ARCH) +# include +#endif #endif /* Hash table mapping symbol names to Symbol */ @@ -102,27 +111,108 @@ ObjectCode *objects = NULL; /* initially empty */ static int ocVerifyImage_ELF ( ObjectCode* oc ); static int ocGetNames_ELF ( ObjectCode* oc ); static int ocResolve_ELF ( ObjectCode* oc ); -#if defined(powerpc_HOST_ARCH) -static int ocAllocateJumpIslands_ELF ( ObjectCode* oc ); +#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) +static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc ); #endif #elif defined(OBJFORMAT_PEi386) 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 ); static int machoGetMisalignment( FILE * ); +#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) +static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc ); +#endif #ifdef powerpc_HOST_ARCH -static int ocAllocateJumpIslands_MachO ( ObjectCode* oc ); static void machoInitSymbolsWithoutUnderscore( void ); #endif #endif +/* on x86_64 we have a problem with relocating symbol references in + * code that was compiled without -fPIC. By default, the small memory + * model is used, which assumes that symbol references can fit in a + * 32-bit slot. The system dynamic linker makes this work for + * references to shared libraries by either (a) allocating a jump + * table slot for code references, or (b) moving the symbol at load + * time (and copying its contents, if necessary) for data references. + * + * We unfortunately can't tell whether symbol references are to code + * or data. So for now we assume they are code (the vast majority + * are), and allocate jump-table slots. Unfortunately this will + * SILENTLY generate crashing code for data references. This hack is + * enabled by X86_64_ELF_NONPIC_HACK. + * + * One workaround is to use shared Haskell libraries. This is + * coming. Another workaround is to keep the static libraries but + * compile them with -fPIC, because that will generate PIC references + * to data which can be relocated. The PIC code is still too green to + * do this systematically, though. + * + * 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(x86_64_HOST_ARCH) -static void*x86_64_high_symbol( char *lbl, void *addr ); + +#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 /* ----------------------------------------------------------------------------- @@ -134,21 +224,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(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) @@ -157,83 +247,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 /**/ @@ -245,504 +335,624 @@ typedef struct _RtsSymbolVal { /* 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) + SymI_NeedsProto(_imp____mb_cur_max) \ + SymI_NeedsProto(_imp___pctype) #else #define RTS_MINGW_EXTRA_SYMS #endif +#if HAVE_GETTIMEOFDAY +#define RTS_MINGW_GETTIMEOFDAY_SYM SymI_NeedsProto(gettimeofday) +#else +#define RTS_MINGW_GETTIMEOFDAY_SYM /**/ +#endif + +#if HAVE___MINGW_VFPRINTF +#define RTS___MINGW_VFPRINTF_SYM SymI_HasProto(__mingw_vfprintf) +#else +#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 \ - 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_NeedsProto(isxdigit) \ + SymI_NeedsProto(isupper) \ + SymI_NeedsProto(ispunct) \ + SymI_NeedsProto(islower) \ + SymI_NeedsProto(isspace) \ + SymI_NeedsProto(isprint) \ + SymI_NeedsProto(isdigit) \ + SymI_NeedsProto(iscntrl) \ + SymI_NeedsProto(isalpha) \ + SymI_NeedsProto(isalnum) \ + SymI_NeedsProto(isascii) \ + 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) \ + RTS_MINGW_EXTRA_SYMS \ + 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) +#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(setIOManagerPipe) \ + 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(sendIOManagerEvent) \ + SymI_HasProto(readIOManagerEvent) \ + SymI_HasProto(getIOManagerEvent) \ + SymI_HasProto(console_handler) #endif +#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 -#define RTS_SYMBOLS \ - Maybe_Stable_Names \ - Sym(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) \ - SymX(stg_seq_frame_info) \ - MAIN_CAP_SYM \ - SymX(MallocFailHook) \ - SymX(OnExitHook) \ - SymX(OutOfHeapHook) \ - SymX(StackOverflowHook) \ - SymX(__encodeDouble) \ - SymX(__encodeFloat) \ - SymX(addDLL) \ - SymX(__gmpn_gcd_1) \ - SymX(__gmpz_cmp) \ - SymX(__gmpz_cmp_si) \ - SymX(__gmpz_cmp_ui) \ - SymX(__gmpz_get_si) \ - SymX(__gmpz_get_ui) \ - SymX(__int_encodeDouble) \ - SymX(__int_encodeFloat) \ - SymX(andIntegerzh_fast) \ - SymX(atomicallyzh_fast) \ - SymX(barf) \ - SymX(debugBelch) \ - SymX(errorBelch) \ - 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(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(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(initLinker) \ - SymX(infoPtrzh_fast) \ - SymX(closurePayloadzh_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(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_getInt32) \ - SymX(rts_getPtr) \ - SymX(rts_getFunPtr) \ - SymX(rts_getStablePtr) \ - SymX(rts_getThreadId) \ - SymX(rts_getWord) \ - SymX(rts_getWord32) \ - SymX(rts_lock) \ - SymX(rts_mkBool) \ - SymX(rts_mkChar) \ - SymX(rts_mkDouble) \ - SymX(rts_mkFloat) \ - SymX(rts_mkInt) \ - SymX(rts_mkInt16) \ - SymX(rts_mkInt32) \ - SymX(rts_mkInt64) \ - SymX(rts_mkInt8) \ - SymX(rts_mkPtr) \ - SymX(rts_mkFunPtr) \ - SymX(rts_mkStablePtr) \ - SymX(rts_mkString) \ - SymX(rts_mkWord) \ - SymX(rts_mkWord16) \ - SymX(rts_mkWord32) \ - SymX(rts_mkWord64) \ - SymX(rts_mkWord8) \ - 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(stg_CHARLIKE_closure) \ - SymX(stg_EMPTY_MVAR_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(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) \ - SymX(stg_interp_constr_entry) \ - SymX(stg_interp_constr1_entry) \ - SymX(stg_interp_constr2_entry) \ - SymX(stg_interp_constr3_entry) \ - SymX(stg_interp_constr4_entry) \ - SymX(stg_interp_constr5_entry) \ - SymX(stg_interp_constr6_entry) \ - SymX(stg_interp_constr7_entry) \ - SymX(stg_interp_constr8_entry) \ - SymX(allocateExec) \ - SymX(freeExec) \ - SymX(getAllocations) \ - SymX(revertCAFs) \ - SymX(RtsFlags) \ +/* 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) + + +#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_asyncExceptionsBlockedzh) \ + SymI_HasProto(stg_blockAsyncExceptionszh) \ + 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(getOrSetSignalHandlerStore) \ + 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_isCurrentThreadBoundzh) \ + SymI_HasProto(stg_isEmptyMVarzh) \ + SymI_HasProto(stg_killThreadzh) \ + 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(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_EAGER_BLACKHOLE_info) \ + SymI_HasProto(startTimer) \ + SymI_HasProto(stg_CHARLIKE_closure) \ + SymI_HasProto(stg_MVAR_CLEAN_info) \ + SymI_HasProto(stg_MVAR_DIRTY_info) \ + SymI_HasProto(stg_IND_STATIC_info) \ + SymI_HasProto(stg_INTLIKE_closure) \ + SymI_HasProto(stg_ARR_WORDS_info) \ + SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info) \ + SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info) \ + SymI_HasProto(stg_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(suspendThread) \ + SymI_HasProto(stg_takeMVarzh) \ + SymI_HasProto(stg_threadStatuszh) \ + SymI_HasProto(stg_tryPutMVarzh) \ + SymI_HasProto(stg_tryTakeMVarzh) \ + SymI_HasProto(stg_unblockAsyncExceptionszh) \ + 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(alloc_blocks) \ + SymI_HasProto(alloc_blocks_lim) \ + SymI_HasProto(allocateLocal) \ + 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 -#ifdef SUPPORT_LONG_LONGS -#define RTS_LONG_LONG_SYMS \ - SymX(int64ToIntegerzh_fast) \ - SymX(word64ToIntegerzh_fast) -#else -#define RTS_LONG_LONG_SYMS /* nothing */ -#endif // 64-bit support functions in libgcc.a #if defined(__GNUC__) && SIZEOF_VOID_P <= 4 -#define RTS_LIBGCC_SYMBOLS \ - Sym(__divdi3) \ - Sym(__udivdi3) \ - Sym(__moddi3) \ - Sym(__umoddi3) \ - Sym(__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) \ + SymI_NeedsProto(__eprintf) #else #define RTS_LIBGCC_SYMBOLS #endif @@ -752,25 +962,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); -#define SymX(vvv) /**/ -#define SymX_redirect(vvv,xxx) /**/ +#define SymI_NeedsProto(vvv) extern void vvv(void); +#if defined(__PIC__) && defined(mingw32_TARGET_OS) +#define SymE_HasProto(vvv) SymE_HasProto(vvv); +#define SymE_NeedsProto(vvv) extern void _imp__ ## vvv (void); +#else +#define SymE_NeedsProto(vvv) SymI_NeedsProto(vvv); +#define SymE_HasProto(vvv) SymI_HasProto(vvv) +#endif +#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 -#undef Sym -#undef SymX -#undef SymX_redirect +RTS_LIBFFI_SYMBOLS +#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) @@ -778,25 +997,29 @@ RTS_LIBGCC_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 SymE_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ + (void*)DLL_IMPORT_DATA_REF(vvv) }, + +#define SymI_NeedsProto(vvv) SymI_HasProto(vvv) +#define SymE_NeedsProto(vvv) SymE_HasProto(vvv) -// SymX_redirect allows us to redirect references to one symbol to +// 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 RTS_DARWIN_ONLY_SYMBOLS RTS_LIBGCC_SYMBOLS + RTS_LIBFFI_SYMBOLS #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH) // dyld stub code contains references to this, // but it should never be called because we treat @@ -883,6 +1106,23 @@ initLinker( void ) dl_prog_handle = dlopen(NULL, RTLD_LAZY); # endif /* RTLD_DEFAULT */ # endif + +#if 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 } /* ----------------------------------------------------------------------------- @@ -920,17 +1160,19 @@ typedef static OpenedDLL* opened_dlls = NULL; #endif -char * +const char * addDLL( char *dll_name ) { # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) /* ------------------- ELF DLL loader ------------------- */ void *hdl; - char *errmsg; + const char *errmsg; initLinker(); - hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL); + // omitted: RTLD_NOW + // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html + hdl= dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL); if (hdl == NULL) { /* dlopen failed; return a ptr to the error msg. */ @@ -973,14 +1215,19 @@ addDLL( char *dll_name ) sprintf(buf, "%s.DLL", dll_name); instance = LoadLibrary(buf); if (instance == NULL) { - sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv) - instance = LoadLibrary(buf); - if (instance == NULL) { - stgFree(buf); - - /* LoadLibrary failed; return a ptr to the error msg. */ - return "addDLL: unknown error"; - } + if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error; + // KAA: allow loading of drivers (like winspool.drv) + sprintf(buf, "%s.DRV", dll_name); + instance = LoadLibrary(buf); + if (instance == NULL) { + if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error; + // #1883: allow loading of unix-style libfoo.dll DLLs + sprintf(buf, "lib%s.DLL", dll_name); + instance = LoadLibrary(buf); + if (instance == NULL) { + goto error; + } + } } stgFree(buf); @@ -993,6 +1240,14 @@ addDLL( char *dll_name ) opened_dlls = o_dll; return NULL; + +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 @@ -1031,50 +1286,40 @@ lookupSymbol( char *lbl ) if (val == NULL) { # if defined(OBJFORMAT_ELF) -# if defined(x86_64_HOST_ARCH) - val = dlsym(dl_prog_handle, lbl); - if (val >= (void *)0x80000000) { - void *new_val; - new_val = x86_64_high_symbol(lbl, val); - IF_DEBUG(linker,debugBelch("lookupSymbol: relocating out of range symbol: %s = %p, now %p\n", lbl, val, new_val)); - return new_val; - } else { - return val; - } -# else return dlsym(dl_prog_handle, lbl); -# endif # elif defined(OBJFORMAT_MACHO) +# if HAVE_DLFCN_H + /* On OS X 10.3 and later, we use dlsym instead of the old legacy + interface. + + HACK: On OS X, global symbols are prefixed with an underscore. + However, dlsym wants us to omit the leading underscore from the + symbol name. For now, we simply strip it off here (and ONLY + here). + */ + ASSERT(lbl[0] == '_'); + return dlsym(dl_prog_handle, lbl+1); +# else if(NSIsSymbolNameDefined(lbl)) { NSSymbol symbol = NSLookupAndBindSymbol(lbl); return NSAddressOfSymbol(symbol); } else { return NULL; } +# 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(lbl); + if (sym != NULL) { return sym; }; + + // Also try looking up the symbol without the @N suffix. Some + // DLLs have the suffixes on their symbols, some don't. + zapTrailingAtSign ( lbl ); + sym = lookupSymbolInDLLs(lbl); + if (sym != NULL) { return sym; }; return NULL; + # else ASSERT(2+2 == 5); return NULL; @@ -1084,23 +1329,6 @@ lookupSymbol( char *lbl ) } } -static -__attribute((unused)) -void * -lookupLocalSymbol( ObjectCode* oc, char *lbl ) -{ - void *val; - initLinker() ; - val = lookupStrHashTable(oc->lochash, lbl); - - if (val == NULL) { - return NULL; - } else { - return val; - } -} - - /* ----------------------------------------------------------------------------- * Debugging aid: look in GHCi's object symbol tables for symbols * within DELTA bytes of the specified address, and show their names. @@ -1122,11 +1350,7 @@ void ghci_enquire ( char* addr ) for (i = 0; i < oc->n_symbols; i++) { sym = oc->symbols[i]; if (sym == NULL) continue; - // debugBelch("enquire %p %p\n", sym, oc->lochash); a = NULL; - if (oc->lochash != NULL) { - a = lookupStrHashTable(oc->lochash, sym); - } if (a == NULL) { a = lookupStrHashTable(symhash, sym); } @@ -1141,9 +1365,78 @@ 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(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(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) + // 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 /* ----------------------------------------------------------------------------- * Load an obj (populate the global symbol table, but don't resolve yet) @@ -1155,10 +1448,9 @@ loadObj( char *path ) { ObjectCode* oc; struct stat st; - int r, n; + int r; #ifdef USE_MMAP - int fd, pagesize; - void *map_addr = NULL; + int fd; #else FILE *f; #endif @@ -1211,7 +1503,6 @@ loadObj( char *path ) oc->fileSize = st.st_size; oc->symbols = NULL; oc->sections = NULL; - oc->lochash = allocStrHashTable(); oc->proddables = NULL; /* chain it onto the list of objects */ @@ -1219,8 +1510,6 @@ loadObj( char *path ) objects = oc; #ifdef USE_MMAP -#define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1)) - /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */ #if defined(openbsd_HOST_OS) @@ -1231,40 +1520,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). - */ -#ifdef x86_64_HOST_ARCH -#define EXTRA_MAP_FLAGS MAP_32BIT -#else -#define EXTRA_MAP_FLAGS 0 -#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); + oc->image = mmapForLinker(oc->fileSize, 0, fd); close(fd); #else /* !USE_MMAP */ - /* load the image into memory */ f = fopen(path, "rb"); if (!f) @@ -1292,19 +1552,20 @@ loadObj( char *path ) oc->image = stgMallocBytes(oc->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 ( oc->image, 1, oc->fileSize, f ); + if (n != oc->fileSize) + barf("loadObj: error whilst reading `%s'", path); + } fclose(f); - #endif /* USE_MMAP */ -# if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH) - r = ocAllocateJumpIslands_MachO ( oc ); +# if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)) + r = ocAllocateSymbolExtras_MachO ( oc ); if (!r) { return r; } -# elif defined(OBJFORMAT_ELF) && defined(powerpc_HOST_ARCH) - r = ocAllocateJumpIslands_ELF ( oc ); +# elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)) + r = ocAllocateSymbolExtras_ELF ( oc ); if (!r) { return r; } #endif @@ -1414,9 +1675,6 @@ unloadObj( char *path ) stgFree(oc->fileName); stgFree(oc->symbols); stgFree(oc->sections); - /* The local hash table should have been freed at the end - of the ocResolve_ call on it. */ - ASSERT(oc->lochash == NULL); stgFree(oc); return 1; } @@ -1478,37 +1736,46 @@ static void addSection ( ObjectCode* oc, SectionKind kind, /* -------------------------------------------------------------------------- - * PowerPC specifics (jump islands) - * ------------------------------------------------------------------------*/ + * Symbol Extras. + * This is about allocating a small chunk of memory for every symbol in the + * object file. We make sure that the SymboLExtras are always "in range" of + * limited-range PC-relative instructions on various platforms by allocating + * them right next to the object code itself. + */ -#if defined(powerpc_HOST_ARCH) +#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) /* - ocAllocateJumpIslands + ocAllocateSymbolExtras Allocate additional space at the end of the object file image to make room - for jump islands. + for jump islands (powerpc, x86_64) and GOT entries (x86_64). PowerPC relative branch instructions have a 24 bit displacement field. As PPC code is always 4-byte-aligned, this yields a +-32MB range. If a particular imported symbol is outside this range, we have to redirect the jump to a short piece of new code that just loads the 32bit absolute address and jumps there. - This function just allocates space for one 16 byte ppcJumpIsland for every - undefined symbol in the object file. The code for the islands is filled in by - makeJumpIsland below. + On x86_64, PC-relative jumps and PC-relative accesses to the GOT are limited + to 32 bits (+-2GB). + + This function just allocates space for one SymbolExtra for every + undefined symbol in the object file. The code for the jump islands is + filled in by makeSymbolExtra below. */ -static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first ) +static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first ) { #ifdef USE_MMAP int pagesize, n, m; #endif int aligned; +#ifndef USE_MMAP int misalignment = 0; -#if darwin_HOST_OS +#ifdef darwin_HOST_OS misalignment = oc->misalignment; #endif +#endif if( count > 0 ) { @@ -1516,97 +1783,88 @@ static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first ) aligned = (oc->fileSize + 3) & ~3; #ifdef USE_MMAP - #ifndef linux_HOST_OS /* mremap is a linux extension */ - #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined - #endif - pagesize = getpagesize(); n = ROUND_UP( oc->fileSize, pagesize ); - m = ROUND_UP( aligned + sizeof (ppcJumpIsland) * 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. - */ + m = ROUND_UP( aligned + sizeof (SymbolExtra) * count, pagesize ); - if( m > n ) + /* 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 ) // 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, misalignment + - aligned + sizeof (ppcJumpIsland) * count, - "ocAllocateJumpIslands" ); + aligned + sizeof (SymbolExtra) * count, + "ocAllocateSymbolExtras" ); oc->image += misalignment; + + oc->symbol_extras = (SymbolExtra *) (oc->image + aligned); #endif /* USE_MMAP */ - oc->jump_islands = (ppcJumpIsland *) (oc->image + aligned); - memset( oc->jump_islands, 0, sizeof (ppcJumpIsland) * count ); + memset( oc->symbol_extras, 0, sizeof (SymbolExtra) * count ); } else - oc->jump_islands = NULL; + oc->symbol_extras = NULL; - oc->island_start_symbol = first; - oc->n_islands = count; + oc->first_symbol_extra = first; + oc->n_symbol_extras = count; return 1; } -static unsigned long makeJumpIsland( ObjectCode* oc, +static SymbolExtra* makeSymbolExtra( ObjectCode* oc, unsigned long symbolNumber, unsigned long target ) { - ppcJumpIsland *island; + SymbolExtra *extra; - if( symbolNumber < oc->island_start_symbol || - symbolNumber - oc->island_start_symbol > oc->n_islands) - return 0; + ASSERT( symbolNumber >= oc->first_symbol_extra + && symbolNumber - oc->first_symbol_extra < oc->n_symbol_extras); - island = &oc->jump_islands[symbolNumber - oc->island_start_symbol]; + extra = &oc->symbol_extras[symbolNumber - oc->first_symbol_extra]; +#ifdef powerpc_HOST_ARCH // lis r12, hi16(target) - island->lis_r12 = 0x3d80; - island->hi_addr = target >> 16; + extra->jumpIsland.lis_r12 = 0x3d80; + extra->jumpIsland.hi_addr = target >> 16; // ori r12, r12, lo16(target) - island->ori_r12_r12 = 0x618c; - island->lo_addr = target & 0xffff; + extra->jumpIsland.ori_r12_r12 = 0x618c; + extra->jumpIsland.lo_addr = target & 0xffff; // mtctr r12 - island->mtctr_r12 = 0x7d8903a6; + extra->jumpIsland.mtctr_r12 = 0x7d8903a6; // bctr - island->bctr = 0x4e800420; + extra->jumpIsland.bctr = 0x4e800420; +#endif +#ifdef x86_64_HOST_ARCH + // jmp *-14(%rip) + static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF }; + extra->addr = target; + memcpy(extra->jumpIsland, jmp, 6); +#endif - return (unsigned long) island; + return extra; } +#endif + +/* -------------------------------------------------------------------------- + * PowerPC specifics (instruction cache flushing) + * ------------------------------------------------------------------------*/ + +#ifdef powerpc_TARGET_ARCH /* ocFlushInstructionCache @@ -1617,7 +1875,7 @@ static unsigned long makeJumpIsland( ObjectCode* oc, static void ocFlushInstructionCache( ObjectCode *oc ) { - int n = (oc->fileSize + sizeof( ppcJumpIsland ) * oc->n_islands + 3) / 4; + int n = (oc->fileSize + sizeof( SymbolExtra ) * oc->n_symbol_extras + 3) / 4; unsigned long *p = (unsigned long *) oc->image; while( n-- ) @@ -1893,6 +2151,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, (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; + } + } + return NULL; +} + static int ocVerifyImage_PEi386 ( ObjectCode* oc ) @@ -2192,6 +2480,8 @@ ocGetNames_PEi386 ( ObjectCode* oc ) && 0 != strcmp(".ctors", sectab_i->Name) /* ignore section generated from .ident */ && 0!= strcmp("/4", sectab_i->Name) + /* ignore unknown section that appeared in gcc 3.4.5(?) */ + && 0!= strcmp(".reloc", sectab_i->Name) ) { errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName); return 0; @@ -2409,17 +2699,9 @@ ocResolve_PEi386 ( ObjectCode* oc ) + sym->Value); } else { copyName ( sym->Name, strtab, symbol, 1000-1 ); - S = (UInt32) lookupLocalSymbol( oc, symbol ); - if ((void*)S != NULL) goto foundit; S = (UInt32) lookupSymbol( symbol ); if ((void*)S != NULL) goto foundit; - zapTrailingAtSign ( symbol ); - S = (UInt32) lookupLocalSymbol( oc, symbol ); - if ((void*)S != NULL) goto foundit; - S = (UInt32) lookupSymbol( 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:; } @@ -2488,24 +2770,23 @@ 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) -#include +# include #else /* openbsd elf has things in different places, with diff names */ -#include -#include -#define R_386_32 RELOC_32 -#define R_386_PC32 RELOC_PC32 +# include +# include +# define R_386_32 RELOC_32 +# define R_386_PC32 RELOC_PC32 #endif +/* If elf.h doesn't define it */ +# ifndef R_X86_64_PC64 +# define R_X86_64_PC64 24 +# endif + /* * Define a set of types which can be used for both ELF32 and ELF64 */ @@ -2618,30 +2899,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)]; @@ -2670,64 +2927,6 @@ PLTSize(void) #endif -#if x86_64_HOST_ARCH -// On x86_64, 32-bit relocations are often used, which requires that -// we can resolve a symbol to a 32-bit offset. However, shared -// libraries are placed outside the 2Gb area, which leaves us with a -// problem when we need to give a 32-bit offset to a symbol in a -// shared library. -// -// For a function symbol, we can allocate a bounce sequence inside the -// 2Gb area and resolve the symbol to this. The bounce sequence is -// simply a long jump instruction to the real location of the symbol. -// -// For data references, we're screwed. -// -typedef struct { - unsigned char jmp[8]; /* 6 byte instruction: jmpq *0x00000002(%rip) */ - void *addr; -} x86_64_bounce; - -#define X86_64_BB_SIZE 1024 - -static x86_64_bounce *x86_64_bounce_buffer = NULL; -static nat x86_64_bb_next_off; - -static void* -x86_64_high_symbol( char *lbl, void *addr ) -{ - x86_64_bounce *bounce; - - if ( x86_64_bounce_buffer == NULL || - x86_64_bb_next_off >= X86_64_BB_SIZE ) { - x86_64_bounce_buffer = - mmap(NULL, X86_64_BB_SIZE * sizeof(x86_64_bounce), - PROT_EXEC|PROT_READ|PROT_WRITE, - MAP_PRIVATE|MAP_32BIT|MAP_ANONYMOUS, -1, 0); - if (x86_64_bounce_buffer == MAP_FAILED) { - barf("x86_64_high_symbol: mmap failed"); - } - x86_64_bb_next_off = 0; - } - bounce = &x86_64_bounce_buffer[x86_64_bb_next_off]; - bounce->jmp[0] = 0xff; - bounce->jmp[1] = 0x25; - bounce->jmp[2] = 0x02; - bounce->jmp[3] = 0x00; - bounce->jmp[4] = 0x00; - bounce->jmp[5] = 0x00; - bounce->addr = addr; - x86_64_bb_next_off++; - - IF_DEBUG(linker, debugBelch("x86_64: allocated bounce entry for %s->%p at %p\n", - lbl, addr, bounce)); - - insertStrHashTable(symhash, lbl, bounce); - return bounce; -} -#endif - - /* * Generic ELF functions */ @@ -2757,25 +2956,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 ) { @@ -2830,9 +3010,12 @@ ocVerifyImage_ELF ( ObjectCode* oc ) case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break; #ifdef EM_X86_64 case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break; +#elif defined(EM_AMD64) + case EM_AMD64: IF_DEBUG(linker,debugBelch( "amd64" )); break; #endif default: IF_DEBUG(linker,debugBelch( "unknown" )); - errorBelch("%s: unknown architecture", oc->fileName); + errorBelch("%s: unknown architecture (e_machine == %d)" + , oc->fileName, ehdr->e_machine); return 0; } @@ -3093,7 +3276,7 @@ ocGetNames_ELF ( ObjectCode* oc ) if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC) ad = (char *)allocateFunctionDesc((Elf_Addr)ad); #endif - IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s", + IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s\n", ad, oc->fileName, nm )); isLocal = FALSE; } @@ -3266,9 +3449,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 @@ -3345,49 +3525,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; @@ -3414,12 +3575,13 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, if( delta << 6 >> 6 != delta ) { - value = makeJumpIsland( oc, ELF_R_SYM(info), value ); + value = (Elf_Addr) (&makeSymbolExtra( oc, ELF_R_SYM(info), value ) + ->jumpIsland); delta = value - P; if( value == 0 || delta << 6 >> 6 != delta ) { - barf( "Unable to make ppcJumpIsland for #%d", + barf( "Unable to make SymbolExtra for #%d", ELF_R_SYM(info) ); return 0; } @@ -3439,28 +3601,73 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, { StgInt64 off = value - P; if (off >= 0x7fffffffL || off < -0x80000000L) { - barf("R_X86_64_PC32 relocation out of range: %s = %p", - symbol, off); - } +#if X86_64_ELF_NONPIC_HACK + StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S) + -> jumpIsland; + off = pltAddress + A - P; +#else + barf("R_X86_64_PC32 relocation out of range: %s = %p\nRecompile %s with -fPIC.", + symbol, off, oc->fileName ); +#endif + } + *(Elf64_Word *)P = (Elf64_Word)off; + break; + } + + case R_X86_64_PC64: + { + StgInt64 off = value - P; *(Elf64_Word *)P = (Elf64_Word)off; break; } case R_X86_64_32: if (value >= 0x7fffffffL) { - barf("R_X86_64_32 relocation out of range: %s = %p\n", - symbol, value); - } +#if X86_64_ELF_NONPIC_HACK + StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S) + -> jumpIsland; + value = pltAddress + A; +#else + barf("R_X86_64_32 relocation out of range: %s = %p\nRecompile %s with -fPIC.", + symbol, value, oc->fileName ); +#endif + } *(Elf64_Word *)P = (Elf64_Word)value; break; case R_X86_64_32S: if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) { - barf("R_X86_64_32S relocation out of range: %s = %p\n", - symbol, value); +#if X86_64_ELF_NONPIC_HACK + StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S) + -> jumpIsland; + value = pltAddress + A; +#else + barf("R_X86_64_32S relocation out of range: %s = %p\nRecompile %s with -fPIC.", + symbol, value, oc->fileName ); +#endif } *(Elf64_Sword *)P = (Elf64_Sword)value; break; + + case R_X86_64_GOTPCREL: + { + StgInt64 gotAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)->addr; + StgInt64 off = gotAddress + A - P; + *(Elf64_Word *)P = (Elf64_Word)off; + break; + } + + case R_X86_64_PLT32: + { + StgInt64 off = value - P; + if (off >= 0x7fffffffL || off < -0x80000000L) { + StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S) + -> jumpIsland; + off = pltAddress + A - P; + } + *(Elf64_Word *)P = (Elf64_Word)off; + break; + } #endif default: @@ -3509,10 +3716,6 @@ ocResolve_ELF ( ObjectCode* oc ) } } - /* Free the local symbol table; we won't need it again. */ - freeHashTable(oc->lochash, NULL); - oc->lochash = NULL; - #if defined(powerpc_HOST_ARCH) ocFlushInstructionCache( oc ); #endif @@ -3521,104 +3724,12 @@ 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 ELF specifics + * PowerPC & X86_64 ELF specifics */ -#ifdef powerpc_HOST_ARCH +#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) -static int ocAllocateJumpIslands_ELF( ObjectCode *oc ) +static int ocAllocateSymbolExtras_ELF( ObjectCode *oc ) { Elf_Ehdr *ehdr; Elf_Shdr* shdr; @@ -3640,12 +3751,12 @@ static int ocAllocateJumpIslands_ELF( ObjectCode *oc ) if( shdr[i].sh_entsize != sizeof( Elf_Sym ) ) { errorBelch( "The entry size (%d) of the symtab isn't %d\n", - shdr[i].sh_entsize, sizeof( Elf_Sym ) ); + (int) shdr[i].sh_entsize, (int) sizeof( Elf_Sym ) ); return 0; } - return ocAllocateJumpIslands( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 ); + return ocAllocateSymbolExtras( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 ); } #endif /* powerpc */ @@ -3668,8 +3779,15 @@ static int ocAllocateJumpIslands_ELF( ObjectCode *oc ) *) add still more sanity checks. */ +#if x86_64_HOST_ARCH || powerpc64_HOST_ARCH +#define mach_header mach_header_64 +#define segment_command segment_command_64 +#define section section_64 +#define nlist nlist_64 +#endif + #ifdef powerpc_HOST_ARCH -static int ocAllocateJumpIslands_MachO(ObjectCode* oc) +static int ocAllocateSymbolExtras_MachO(ObjectCode* oc) { struct mach_header *header = (struct mach_header *) oc->image; struct load_command *lc = (struct load_command *) (header + 1); @@ -3704,20 +3822,52 @@ static int ocAllocateJumpIslands_MachO(ObjectCode* oc) } } if(max >= min) - return ocAllocateJumpIslands(oc, max - min + 1, min); + return ocAllocateSymbolExtras(oc, max - min + 1, min); break; } lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize ); } - return ocAllocateJumpIslands(oc,0,0); + return ocAllocateSymbolExtras(oc,0,0); } #endif +#ifdef x86_64_HOST_ARCH +static int ocAllocateSymbolExtras_MachO(ObjectCode* oc) +{ + struct mach_header *header = (struct mach_header *) oc->image; + struct load_command *lc = (struct load_command *) (header + 1); + unsigned i; -static int ocVerifyImage_MachO(ObjectCode* oc STG_UNUSED) + for( i = 0; i < header->ncmds; i++ ) + { + if( lc->cmd == LC_SYMTAB ) + { + // Just allocate one entry for every symbol + struct symtab_command *symLC = (struct symtab_command *) lc; + + return ocAllocateSymbolExtras(oc, symLC->nsyms, 0); + } + + lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize ); + } + return ocAllocateSymbolExtras(oc,0,0); +} +#endif + +static int ocVerifyImage_MachO(ObjectCode* oc) { - // FIXME: do some verifying here + 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) + return 0; +#else + if(header->magic != MH_MAGIC) + return 0; +#endif + // FIXME: do some more verifying here return 1; } @@ -3752,8 +3902,6 @@ static int resolveImports( if((symbol->n_type & N_TYPE) == N_UNDF && (symbol->n_type & N_EXT) && (symbol->n_value != 0)) addr = (void*) (symbol->n_value); - else if((addr = lookupLocalSymbol(oc,nm)) != NULL) - ; else addr = lookupSymbol(nm); if(!addr) @@ -3826,6 +3974,111 @@ static int relocateSection( for(i=0;ioffset + reloc->r_address; + uint64_t thing; + /* 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; + + checkProddableBlock(oc,thingPtr); + switch(reloc->r_length) + { + case 0: + thing = *(uint8_t*)thingPtr; + baseValue = (uint64_t)thingPtr + 1; + break; + case 1: + thing = *(uint16_t*)thingPtr; + baseValue = (uint64_t)thingPtr + 2; + break; + case 2: + thing = *(uint32_t*)thingPtr; + baseValue = (uint64_t)thingPtr + 4; + break; + case 3: + thing = *(uint64_t*)thingPtr; + baseValue = (uint64_t)thingPtr + 8; + break; + default: + barf("Unknown size."); + } + + if(type == X86_64_RELOC_GOT + || type == X86_64_RELOC_GOT_LOAD) + { + ASSERT(reloc->r_extern); + value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)->addr; + + type = X86_64_RELOC_SIGNED; + } + else if(reloc->r_extern) + { + 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 + value = relocateAddress(oc, nSections, sections, + symbol->n_value); + } + else + { + value = sections[reloc->r_symbolnum-1].offset + - sections[reloc->r_symbolnum-1].addr + + (uint64_t) image; + } + + if(type == X86_64_RELOC_BRANCH) + { + if((int32_t)(value - baseValue) != (int64_t)(value - baseValue)) + { + ASSERT(reloc->r_extern); + value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value) + -> jumpIsland; + } + ASSERT((int32_t)(value - baseValue) == (int64_t)(value - baseValue)); + type = X86_64_RELOC_SIGNED; + } + + switch(type) + { + case X86_64_RELOC_UNSIGNED: + ASSERT(!reloc->r_pcrel); + thing += value; + break; + case X86_64_RELOC_SIGNED: + ASSERT(reloc->r_pcrel); + thing += value - baseValue; + break; + case X86_64_RELOC_SUBTRACTOR: + ASSERT(!reloc->r_pcrel); + thing -= value; + break; + default: + barf("unkown relocation"); + } + + switch(reloc->r_length) + { + case 0: + *(uint8_t*)thingPtr = thing; + break; + case 1: + *(uint16_t*)thingPtr = thing; + break; + case 2: + *(uint32_t*)thingPtr = thing; + break; + case 3: + *(uint64_t*)thingPtr = thing; + break; + } +#else if(relocs[i].r_address & R_SCATTERED) { struct scattered_relocation_info *scat = @@ -4023,8 +4276,12 @@ static int relocateSection( #ifdef powerpc_HOST_ARCH // In the .o file, this should be a relative jump to NULL // and we'll change it to a relative jump to the symbol - ASSERT(-word == reloc->r_address); - jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,(unsigned long) symbolAddress); + ASSERT(word + reloc->r_address == 0); + jumpIsland = (unsigned long) + &makeSymbolExtra(oc, + reloc->r_symbolnum, + (unsigned long) symbolAddress) + -> jumpIsland; if(jumpIsland != 0) { offsetToJumpIsland = word + jumpIsland @@ -4087,6 +4344,7 @@ static int relocateSection( barf("\nunknown relocation %d",reloc->r_type); return 0; } +#endif } return 1; } @@ -4107,7 +4365,7 @@ static int ocGetNames_MachO(ObjectCode* oc) for(i=0;incmds;i++) { - if(lc->cmd == LC_SEGMENT) + if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64) segLC = (struct segment_command*) lc; else if(lc->cmd == LC_SYMTAB) symLC = (struct symtab_command*) lc; @@ -4117,6 +4375,9 @@ static int ocGetNames_MachO(ObjectCode* oc) sections = (struct section*) (segLC+1); nlist = symLC ? (struct nlist*) (image + symLC->symoff) : NULL; + + if(!segLC) + barf("ocGetNames_MachO: no segment load command"); for(i=0;insects;i++) { @@ -4187,21 +4448,17 @@ static int ocGetNames_MachO(ObjectCode* oc) if(nlist[i].n_type & N_EXT) { char *nm = image + symLC->stroff + nlist[i].n_un.n_strx; - ghciInsertStrHashTable(oc->fileName, symhash, nm, - image - + sections[nlist[i].n_sect-1].offset - - sections[nlist[i].n_sect-1].addr - + nlist[i].n_value); - oc->symbols[curSymbol++] = nm; - } - else - { - char *nm = image + symLC->stroff + nlist[i].n_un.n_strx; - ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, - image - + sections[nlist[i].n_sect-1].offset - - sections[nlist[i].n_sect-1].addr - + nlist[i].n_value); + if((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm)) + ; // weak definition, and we already have a definition + else + { + ghciInsertStrHashTable(oc->fileName, symhash, nm, + image + + sections[nlist[i].n_sect-1].offset + - sections[nlist[i].n_sect-1].addr + + nlist[i].n_value); + oc->symbols[curSymbol++] = nm; + } } } } @@ -4246,7 +4503,7 @@ static int ocResolve_MachO(ObjectCode* oc) for(i=0;incmds;i++) { - if(lc->cmd == LC_SEGMENT) + if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64) segLC = (struct segment_command*) lc; else if(lc->cmd == LC_SYMTAB) symLC = (struct symtab_command*) lc; @@ -4293,10 +4550,6 @@ static int ocResolve_MachO(ObjectCode* oc) return 0; } - /* Free the local symbol table; we won't need it again. */ - freeHashTable(oc->lochash, NULL); - oc->lochash = NULL; - #if defined (powerpc_HOST_ARCH) ocFlushInstructionCache( oc ); #endif @@ -4320,21 +4573,21 @@ static void machoInitSymbolsWithoutUnderscore() 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 @@ -4350,9 +4603,14 @@ 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) + return 0; +#else if(header.magic != MH_MAGIC) return 0; - +#endif + misalignment = (header.sizeofcmds + sizeof(header)) & 0xF;