X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FLinker.c;h=b123f78dd2006822b58a31c3120b32d8af56d61f;hp=4aca3978b96e5126ed9c1a074d59ee55d21d4628;hb=7bcf45933a1b386e7f28c0ee7d09d92bad1ee0e7;hpb=82807c2121870bd2458a29037c5518b2bc90007c diff --git a/rts/Linker.c b/rts/Linker.c index 4aca397..b123f78 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -10,7 +10,7 @@ #include "PosixSource.h" #endif -/* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from and +/* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from and MREMAP_MAYMOVE from . */ #ifdef __linux__ @@ -25,8 +25,10 @@ #include "LinkerInternals.h" #include "RtsUtils.h" #include "Schedule.h" -#include "Storage.h" #include "Sparks.h" +#include "RtsGlobals.h" +#include "Timer.h" +#include "Trace.h" #ifdef HAVE_SYS_TYPES_H #include @@ -59,12 +61,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,25 +85,22 @@ # 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 */ static /*Str*/HashTable *symhash; -typedef struct { - void *addr; -} rootEntry; - /* Hash table mapping symbol names to StgStablePtr */ static /*Str*/HashTable *stablehash; -rootEntry *root_ptr_table = NULL; -static rootEntry *root_ptr_free = NULL; - -static unsigned int RPT_size = 0; /* List of currently loaded objects */ ObjectCode *objects = NULL; /* initially empty */ @@ -110,27 +109,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 /* ----------------------------------------------------------------------------- @@ -142,11 +222,11 @@ typedef struct _RtsSymbolVal { void *addr; } RtsSymbolVal; - #if !defined(PAR) -#define Maybe_Stable_Names SymX(mkWeakzh_fast) \ - SymX(makeStableNamezh_fast) \ - SymX(finalizzeWeakzh_fast) +#define Maybe_Stable_Names SymI_HasProto(mkWeakzh_fast) \ + SymI_HasProto(mkWeakForeignEnvzh_fast) \ + SymI_HasProto(makeStableNamezh_fast) \ + SymI_HasProto(finalizzeWeakzh_fast) #else /* These are not available in GUM!!! -- HWL */ #define Maybe_Stable_Names @@ -154,9 +234,12 @@ typedef struct _RtsSymbolVal { #if !defined (mingw32_HOST_OS) #define RTS_POSIX_ONLY_SYMBOLS \ - SymX(signal_handlers) \ - SymX(stg_sig_install) \ - Sym(nocldstop) + SymI_HasProto(shutdownHaskellAndSignal) \ + SymI_NeedsProto(lockFile) \ + SymI_NeedsProto(unlockFile) \ + SymI_HasProto(signal_handlers) \ + SymI_HasProto(stg_sig_install) \ + SymI_NeedsProto(nocldstop) #endif #if defined (cygwin32_HOST_OS) @@ -165,83 +248,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 /**/ @@ -253,494 +336,563 @@ 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 + /* 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___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(asyncReadzh_fast) \ + SymI_HasProto(asyncWritezh_fast) \ + SymI_HasProto(asyncDoProczh_fast) \ + 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_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(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_NeedsProto(blockUserSignals) \ + SymI_NeedsProto(unblockUserSignals) #else -#define RTS_USER_SIGNALS_SYMBOLS /* nothing */ +#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 + +/* On Windows, we link libgmp.a statically into libHSrts.dll */ +#ifdef mingw32_HOST_OS +#define GMP_SYMS \ + SymI_HasProto(__gmpz_cmp) \ + SymI_HasProto(__gmpz_cmp_si) \ + SymI_HasProto(__gmpz_cmp_ui) \ + SymI_HasProto(__gmpz_get_si) \ + SymI_HasProto(__gmpz_get_ui) +#else +#define GMP_SYMS \ + SymE_HasProto(__gmpz_cmp) \ + SymE_HasProto(__gmpz_cmp_si) \ + SymE_HasProto(__gmpz_cmp_ui) \ + SymE_HasProto(__gmpz_get_si) \ + SymE_HasProto(__gmpz_get_ui) #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(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(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(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(stgMallocBytesRWX) \ - SymX(getAllocations) \ - SymX(revertCAFs) \ - SymX(RtsFlags) \ +#define RTS_SYMBOLS \ + Maybe_Stable_Names \ + 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(__encodeDouble) \ + SymI_HasProto(__encodeFloat) \ + SymI_HasProto(addDLL) \ + GMP_SYMS \ + SymI_HasProto(__int_encodeDouble) \ + SymI_HasProto(__word_encodeDouble) \ + SymI_HasProto(__2Int_encodeDouble) \ + SymI_HasProto(__int_encodeFloat) \ + SymI_HasProto(__word_encodeFloat) \ + SymI_HasProto(andIntegerzh_fast) \ + SymI_HasProto(atomicallyzh_fast) \ + SymI_HasProto(barf) \ + SymI_HasProto(debugBelch) \ + SymI_HasProto(errorBelch) \ + SymI_HasProto(sysErrorBelch) \ + SymI_HasProto(asyncExceptionsBlockedzh_fast) \ + SymI_HasProto(blockAsyncExceptionszh_fast) \ + SymI_HasProto(catchzh_fast) \ + SymI_HasProto(catchRetryzh_fast) \ + SymI_HasProto(catchSTMzh_fast) \ + SymI_HasProto(checkzh_fast) \ + SymI_HasProto(closure_flags) \ + SymI_HasProto(cmp_thread) \ + SymI_HasProto(cmpIntegerzh_fast) \ + SymI_HasProto(cmpIntegerIntzh_fast) \ + SymI_HasProto(complementIntegerzh_fast) \ + SymI_HasProto(createAdjustor) \ + SymI_HasProto(decodeDoublezh_fast) \ + SymI_HasProto(decodeFloatzh_fast) \ + SymI_HasProto(decodeDoublezu2Intzh_fast) \ + SymI_HasProto(decodeFloatzuIntzh_fast) \ + SymI_HasProto(defaultsHook) \ + SymI_HasProto(delayzh_fast) \ + SymI_HasProto(deRefWeakzh_fast) \ + SymI_HasProto(deRefStablePtrzh_fast) \ + SymI_HasProto(dirty_MUT_VAR) \ + SymI_HasProto(divExactIntegerzh_fast) \ + SymI_HasProto(divModIntegerzh_fast) \ + SymI_HasProto(forkzh_fast) \ + SymI_HasProto(forkOnzh_fast) \ + SymI_HasProto(forkProcess) \ + SymI_HasProto(forkOS_createThread) \ + SymI_HasProto(freeHaskellFunctionPtr) \ + SymI_HasProto(freeStablePtr) \ + SymI_HasProto(getOrSetTypeableStore) \ + SymI_HasProto(getOrSetSignalHandlerStore) \ + SymI_HasProto(gcdIntegerzh_fast) \ + SymI_HasProto(gcdIntegerIntzh_fast) \ + SymI_HasProto(gcdIntzh_fast) \ + 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(unpackClosurezh_fast) \ + SymI_HasProto(getApStackValzh_fast) \ + SymI_HasProto(getSparkzh_fast) \ + SymI_HasProto(int2Integerzh_fast) \ + SymI_HasProto(integer2Intzh_fast) \ + SymI_HasProto(integer2Wordzh_fast) \ + SymI_HasProto(isCurrentThreadBoundzh_fast) \ + SymI_HasProto(isDoubleDenormalized) \ + SymI_HasProto(isDoubleInfinite) \ + SymI_HasProto(isDoubleNaN) \ + SymI_HasProto(isDoubleNegativeZero) \ + SymI_HasProto(isEmptyMVarzh_fast) \ + SymI_HasProto(isFloatDenormalized) \ + SymI_HasProto(isFloatInfinite) \ + SymI_HasProto(isFloatNaN) \ + SymI_HasProto(isFloatNegativeZero) \ + SymI_HasProto(killThreadzh_fast) \ + SymI_HasProto(loadObj) \ + SymI_HasProto(insertStableSymbol) \ + SymI_HasProto(insertSymbol) \ + SymI_HasProto(lookupSymbol) \ + SymI_HasProto(makeStablePtrzh_fast) \ + SymI_HasProto(minusIntegerzh_fast) \ + SymI_HasProto(mkApUpd0zh_fast) \ + SymI_HasProto(myThreadIdzh_fast) \ + SymI_HasProto(labelThreadzh_fast) \ + SymI_HasProto(newArrayzh_fast) \ + SymI_HasProto(newBCOzh_fast) \ + SymI_HasProto(newByteArrayzh_fast) \ + SymI_HasProto_redirect(newCAF, newDynCAF) \ + SymI_HasProto(newMVarzh_fast) \ + SymI_HasProto(newMutVarzh_fast) \ + SymI_HasProto(newTVarzh_fast) \ + SymI_HasProto(noDuplicatezh_fast) \ + SymI_HasProto(atomicModifyMutVarzh_fast) \ + SymI_HasProto(newPinnedByteArrayzh_fast) \ + SymI_HasProto(newAlignedPinnedByteArrayzh_fast) \ + SymI_HasProto(newSpark) \ + SymI_HasProto(orIntegerzh_fast) \ + SymI_HasProto(performGC) \ + SymI_HasProto(performMajorGC) \ + SymI_HasProto(plusIntegerzh_fast) \ + SymI_HasProto(prog_argc) \ + SymI_HasProto(prog_argv) \ + SymI_HasProto(putMVarzh_fast) \ + SymI_HasProto(quotIntegerzh_fast) \ + SymI_HasProto(quotRemIntegerzh_fast) \ + SymI_HasProto(raisezh_fast) \ + SymI_HasProto(raiseIOzh_fast) \ + SymI_HasProto(readTVarzh_fast) \ + SymI_HasProto(readTVarIOzh_fast) \ + SymI_HasProto(remIntegerzh_fast) \ + SymI_HasProto(resetNonBlockingFd) \ + SymI_HasProto(resumeThread) \ + SymI_HasProto(resolveObjs) \ + SymI_HasProto(retryzh_fast) \ + 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(rtsSupportsBoundThreads) \ + SymI_HasProto(__hscore_get_saved_termios) \ + SymI_HasProto(__hscore_set_saved_termios) \ + 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(awakenBlockedQueue) \ + 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_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(takeMVarzh_fast) \ + SymI_HasProto(threadStatuszh_fast) \ + SymI_HasProto(timesIntegerzh_fast) \ + SymI_HasProto(tryPutMVarzh_fast) \ + SymI_HasProto(tryTakeMVarzh_fast) \ + SymI_HasProto(unblockAsyncExceptionszh_fast) \ + SymI_HasProto(unloadObj) \ + SymI_HasProto(unsafeThawArrayzh_fast) \ + SymI_HasProto(waitReadzh_fast) \ + SymI_HasProto(waitWritezh_fast) \ + SymI_HasProto(word2Integerzh_fast) \ + SymI_HasProto(writeTVarzh_fast) \ + SymI_HasProto(xorIntegerzh_fast) \ + SymI_HasProto(yieldzh_fast) \ + SymI_NeedsProto(stg_interp_constr_entry) \ + 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(traceCcszh_fast) \ RTS_USER_SIGNALS_SYMBOLS #ifdef SUPPORT_LONG_LONGS -#define RTS_LONG_LONG_SYMS \ - SymX(int64ToIntegerzh_fast) \ - SymX(word64ToIntegerzh_fast) +#define RTS_LONG_LONG_SYMS \ + SymI_HasProto(int64ToIntegerzh_fast) \ + SymI_HasProto(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) +#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) #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(__divsf3) \ + SymI_NeedsProto(__divdf3) #else #define RTS_LIBGCC_SYMBOLS #endif @@ -750,14 +902,21 @@ 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 @@ -766,9 +925,12 @@ 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) @@ -776,13 +938,17 @@ 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) }, -// 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)) }, @@ -793,7 +959,9 @@ static RtsSymbolVal rtsSyms[] = { 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 @@ -804,97 +972,11 @@ static RtsSymbolVal rtsSyms[] = { }; -/* ----------------------------------------------------------------------------- - * Utilities for handling root pointers. - * -------------------------------------------------------------------------- */ - - -#define INIT_RPT_SIZE 64 - -STATIC_INLINE void -initFreeList(rootEntry *table, nat n, rootEntry *free) -{ - rootEntry *p; - - for (p = table + n - 1; p >= table; p--) { - p->addr = (P_)free; - free = p; - } - root_ptr_free = table; -} - -void -initRootPtrTable(void) -{ - if (RPT_size > 0) - return; - - RPT_size = INIT_RPT_SIZE; - root_ptr_table = stgMallocBytes(RPT_size * sizeof(rootEntry), - "initRootPtrTable"); - - initFreeList(root_ptr_table,INIT_RPT_SIZE,NULL); -} - - -void -enlargeRootPtrTable(void) -{ - nat old_RPT_size = RPT_size; - - // 2nd and subsequent times - RPT_size *= 2; - root_ptr_table = - stgReallocBytes(root_ptr_table, - RPT_size * sizeof(rootEntry), - "enlargeRootPtrTable"); - - initFreeList(root_ptr_table + old_RPT_size, old_RPT_size, NULL); -} - -static void -addRootObject(void *addr) -{ - StgWord rt; - initRootPtrTable(); - if (root_ptr_free == NULL) { - enlargeRootPtrTable(); - } - - rt = root_ptr_free - root_ptr_table; - root_ptr_free = (rootEntry*)(root_ptr_free->addr); - root_ptr_table[rt].addr = addr; -} - -/* ----------------------------------------------------------------------------- - * Treat root pointers as roots for the garbage collector. - * -------------------------------------------------------------------------- */ - -void -markRootPtrTable(evac_fn evac) -{ - rootEntry *p, *end_root_ptr_table; - StgPtr q; - - end_root_ptr_table = &root_ptr_table[RPT_size]; - - for (p = root_ptr_table; p < end_root_ptr_table; p++) { - q = p->addr; - - if (q && (q < (P_)root_ptr_table || q >= (P_)end_root_ptr_table)) { - evac((StgClosure **)p->addr); - } - } -} - -/* ----------------------------------------------------------------------------- - * End of utilities for handling root pointers. - * -------------------------------------------------------------------------- */ - /* ----------------------------------------------------------------------------- * Insert symbols into hash tables, checking for duplicates. */ + static void ghciInsertStrHashTable ( char* obj_name, HashTable *table, char* key, @@ -924,8 +1006,6 @@ static void ghciInsertStrHashTable ( char* obj_name, ); exit(1); } - - /* ----------------------------------------------------------------------------- * initialize the object linker */ @@ -937,11 +1017,6 @@ static int linker_init_done = 0 ; static void *dl_prog_handle; #endif -/* dlopen(NULL,..) doesn't work so we grab libc explicitly */ -#if defined(openbsd_HOST_OS) -static void *dl_libc_handle; -#endif - void initLinker( void ) { @@ -971,11 +1046,25 @@ initLinker( void ) dl_prog_handle = RTLD_DEFAULT; # else dl_prog_handle = dlopen(NULL, RTLD_LAZY); -# if defined(openbsd_HOST_OS) - dl_libc_handle = dlopen("libc.so", RTLD_LAZY); -# endif # 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 } /* ----------------------------------------------------------------------------- @@ -1013,17 +1102,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. */ @@ -1066,14 +1157,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); @@ -1086,6 +1182,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 @@ -1124,53 +1228,40 @@ lookupSymbol( char *lbl ) if (val == NULL) { # if defined(OBJFORMAT_ELF) -# if defined(openbsd_HOST_OS) - val = dlsym(dl_prog_handle, lbl); - return (val != NULL) ? val : dlsym(dl_libc_handle,lbl); -# elif 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 /* not openbsd */ 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; @@ -1180,23 +1271,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. @@ -1218,11 +1292,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); } @@ -1241,6 +1311,79 @@ void ghci_enquire ( char* addr ) static unsigned int PLTSize(void); #endif +#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 = 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 = (void*)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) * @@ -1251,19 +1394,17 @@ 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; - int misalignment; #endif initLinker(); /* debugBelch("loadObj %s\n", path ); */ - /* Check that we haven't already loaded this object. + /* Check that we haven't already loaded this object. Ignore requests to load multiple times */ { ObjectCode *o; @@ -1308,7 +1449,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 */ @@ -1316,8 +1456,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) @@ -1328,10 +1466,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 */ + { + int pagesize, n; + pagesize = getpagesize(); 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) @@ -1339,35 +1478,31 @@ loadObj( char *path ) 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); + oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, + MAP_PRIVATE|TRY_MAP_32BIT, fd, 0); if (oc->image == MAP_FAILED) barf("loadObj: can't map `%s'", path); + } +#else + oc->image = mmapForLinker(oc->fileSize, 0, fd); +#endif close(fd); #else /* !USE_MMAP */ - /* load the image into memory */ f = fopen(path, "rb"); if (!f) barf("loadObj: can't read `%s'", path); -#ifdef darwin_HOST_OS +# 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, + PAGE_EXECUTE_READWRITE); +# elif defined(darwin_HOST_OS) // In a Mach-O .o file, all sections can and will be misaligned // if the total size of the headers is not a multiple of the // desired alignment. This is fine for .o files that only serve @@ -1377,28 +1512,27 @@ loadObj( char *path ) // We calculate the correct alignment from the header before // reading the file, and then we misalign oc->image on purpose so // that the actual sections end up aligned again. - misalignment = machoGetMisalignment(f); - oc->misalignment = misalignment; -#else - misalignment = 0; -#endif - - oc->image = stgMallocBytes(oc->fileSize + misalignment, "loadObj(image)"); - oc->image += misalignment; - - n = fread ( oc->image, 1, oc->fileSize, f ); - if (n != oc->fileSize) - barf("loadObj: error whilst reading `%s'", path); + oc->misalignment = machoGetMisalignment(f); + oc->image = stgMallocBytes(oc->fileSize + oc->misalignment, "loadObj(image)"); + oc->image += oc->misalignment; +# else + oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)"); +# endif + { + 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 @@ -1498,15 +1632,16 @@ unloadObj( char *path ) prev->next = oc->next; } - /* We're going to leave this in place, in case there are - any pointers from the heap into it: */ - /* stgFree(oc->image); */ + // We're going to leave this in place, in case there are + // any pointers from the heap into it: + // #ifdef mingw32_HOST_OS + // VirtualFree(oc->image); + // #else + // stgFree(oc->image); + // #endif 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; } @@ -1568,37 +1703,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 ) { @@ -1606,97 +1750,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 @@ -1707,7 +1842,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-- ) @@ -1983,6 +2118,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 ) @@ -2280,6 +2445,10 @@ ocGetNames_PEi386 ( ObjectCode* oc ) && 0 != strcmp(".stabstr", sectab_i->Name) /* ignore constructor section for now */ && 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; @@ -2497,17 +2666,9 @@ ocResolve_PEi386 ( ObjectCode* oc ) + sym->Value); } else { copyName ( sym->Name, strtab, symbol, 1000-1 ); - (void*)S = lookupLocalSymbol( oc, symbol ); + S = (UInt32) lookupSymbol( symbol ); if ((void*)S != NULL) goto foundit; - (void*)S = lookupSymbol( symbol ); - if ((void*)S != NULL) goto foundit; - zapTrailingAtSign ( symbol ); - (void*)S = lookupLocalSymbol( oc, symbol ); - if ((void*)S != NULL) goto foundit; - (void*)S = lookupSymbol( symbol ); - if ((void*)S != NULL) goto foundit; - /* 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:; } @@ -2585,15 +2746,20 @@ ocResolve_PEi386 ( ObjectCode* oc ) #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 */ @@ -2758,64 +2924,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 */ @@ -2918,9 +3026,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; } @@ -3181,7 +3292,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; } @@ -3288,7 +3399,6 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, S = (Elf_Addr)S_tmp; } else { stableVal = deRefStablePtr( stablePtr ); - addRootObject((void*)P); S_tmp = stableVal; S = (Elf_Addr)S_tmp; } @@ -3434,17 +3544,26 @@ 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; @@ -3503,12 +3622,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; } @@ -3528,28 +3648,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: @@ -3598,10 +3763,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 @@ -3702,12 +3863,12 @@ ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc) #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; @@ -3729,12 +3890,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 */ @@ -3757,8 +3918,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); @@ -3793,20 +3961,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; } @@ -3841,8 +4041,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) @@ -3915,6 +4113,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 = @@ -4112,8 +4415,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 @@ -4176,6 +4483,7 @@ static int relocateSection( barf("\nunknown relocation %d",reloc->r_type); return 0; } +#endif } return 1; } @@ -4196,7 +4504,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; @@ -4206,6 +4514,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++) { @@ -4276,21 +4587,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; + } } } } @@ -4335,7 +4642,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; @@ -4382,10 +4689,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 @@ -4409,21 +4712,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 @@ -4439,9 +4742,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; @@ -4449,3 +4757,4 @@ static int machoGetMisalignment( FILE * f ) } #endif +