/* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and
MREMAP_MAYMOVE from <sys/mman.h>.
*/
-#ifdef __linux__
-#define _GNU_SOURCE
+#if defined(__linux__) || defined(__GLIBC__)
+#define _GNU_SOURCE 1
#endif
#include "Rts.h"
-#include "RtsFlags.h"
#include "HsFFI.h"
+
+#include "sm/Storage.h"
+#include "Stats.h"
#include "Hash.h"
-#include "Linker.h"
#include "LinkerInternals.h"
#include "RtsUtils.h"
-#include "Schedule.h"
-#include "Sparks.h"
-#include "RtsTypeable.h"
+#include "Trace.h"
+#include "StgPrimFloat.h" // for __int_encodeFloat etc.
+#include "Stable.h"
+
+#if !defined(mingw32_HOST_OS)
+#include "posix/Signals.h"
+#endif
+
+// get protos for is*()
+#include <ctype.h>
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
+#include <inttypes.h>
#include <stdlib.h>
#include <string.h>
+#include <stdio.h>
+#include <assert.h>
#ifdef HAVE_SYS_STAT_H
#include <sys/stat.h>
#include <sys/wait.h>
#endif
-#if defined(ia64_HOST_ARCH) || defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
+#if !defined(powerpc_HOST_ARCH) && \
+ ( defined(linux_HOST_OS ) || defined(freebsd_HOST_OS) || \
+ defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS ) || \
+ defined(openbsd_HOST_OS ) || defined(darwin_HOST_OS ) || \
+ defined(kfreebsdgnu_HOST_OS) )
+/* Don't use mmap on powerpc_HOST_ARCH as mmap doesn't support
+ * reallocating but we need to allocate jump islands just after each
+ * object images. Otherwise relative branches to jump islands can fail
+ * due to 24-bits displacement overflow.
+ */
#define USE_MMAP
#include <fcntl.h>
#include <sys/mman.h>
-#if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
-#endif
#endif
-#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
+#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
# define OBJFORMAT_ELF
+# include <regex.h> // regex is already used by dlopen() so this is OK
+ // to use here without requiring an additional lib
#elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
# define OBJFORMAT_PEi386
# include <windows.h>
# include <math.h>
#elif defined(darwin_HOST_OS)
# define OBJFORMAT_MACHO
+# include <regex.h>
+# include <mach/machine.h>
+# include <mach-o/fat.h>
# include <mach-o/loader.h>
# include <mach-o/nlist.h>
# include <mach-o/reloc.h>
+#if !defined(HAVE_DLFCN_H)
# include <mach-o/dyld.h>
+#endif
#if defined(powerpc_HOST_ARCH)
# include <mach-o/ppc/reloc.h>
#endif
+#if defined(x86_64_HOST_ARCH)
+# include <mach-o/x86_64/reloc.h>
+#endif
+#endif
+
+#if defined(x86_64_HOST_ARCH) && defined(darwin_HOST_OS)
+#define ALWAYS_PIC
#endif
/* Hash table mapping symbol names to Symbol */
static /*Str*/HashTable *stablehash;
/* List of currently loaded objects */
-ObjectCode *objects = NULL; /* initially empty */
+ObjectCode *objects = NULL; /* initially empty */
+
+static HsInt loadOc( ObjectCode* oc );
+static ObjectCode* mkOc( char *path, char *image, int imageSize,
+ char *archiveMemberName
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ , int misalignment
+#endif
+#endif
+ );
#if defined(OBJFORMAT_ELF)
static int ocVerifyImage_ELF ( ObjectCode* oc );
static int ocGetNames_ELF ( ObjectCode* oc );
static int 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 );
+#ifndef USE_MMAP
static int machoGetMisalignment( FILE * );
+#endif
+#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
+static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
+#endif
#ifdef powerpc_HOST_ARCH
-static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
static void machoInitSymbolsWithoutUnderscore( void );
#endif
#endif
-#if defined(x86_64_HOST_ARCH)
-static void*x86_64_high_symbol( char *lbl, void *addr );
+/* 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(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
+
+#if defined(MAP_32BIT)
+// Try to use MAP_32BIT
+#define MMAP_32BIT_BASE_DEFAULT 0
+#else
+// A guess: 1Gb.
+#define MMAP_32BIT_BASE_DEFAULT 0x40000000
+#endif
+
+static void *mmap_32bit_base = (void *)MMAP_32BIT_BASE_DEFAULT;
+#endif
+
+/* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
+#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
+#define MAP_ANONYMOUS MAP_ANON
#endif
/* -----------------------------------------------------------------------------
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_HasProto(rtsTimerSignal) \
+ SymI_HasProto(atexit) \
+ SymI_NeedsProto(nocldstop)
#endif
#if defined (cygwin32_HOST_OS)
* 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 /**/
#define RTS_POSIX_ONLY_SYMBOLS /**/
#define RTS_CYGWIN_ONLY_SYMBOLS /**/
-/* Extra syms gen'ed by mingw-2's gcc-3.2: */
-#if __GNUC__>=3
-#define RTS_MINGW_EXTRA_SYMS \
- Sym(_imp____mb_cur_max) \
- Sym(_imp___pctype)
+#if HAVE_GETTIMEOFDAY
+#define RTS_MINGW_GETTIMEOFDAY_SYM SymI_NeedsProto(gettimeofday)
+#else
+#define RTS_MINGW_GETTIMEOFDAY_SYM /**/
+#endif
+
+#if HAVE___MINGW_VFPRINTF
+#define RTS___MINGW_VFPRINTF_SYM SymI_HasProto(__mingw_vfprintf)
#else
-#define RTS_MINGW_EXTRA_SYMS
+#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)
-#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_MINGW_ONLY_SYMBOLS \
+ SymI_HasProto(stg_asyncReadzh) \
+ SymI_HasProto(stg_asyncWritezh) \
+ SymI_HasProto(stg_asyncDoProczh) \
+ SymI_HasProto(getWin32ProgArgv) \
+ SymI_HasProto(setWin32ProgArgv) \
+ SymI_HasProto(memset) \
+ SymI_HasProto(inet_ntoa) \
+ SymI_HasProto(inet_addr) \
+ SymI_HasProto(htonl) \
+ SymI_HasProto(recvfrom) \
+ SymI_HasProto(listen) \
+ SymI_HasProto(bind) \
+ SymI_HasProto(shutdown) \
+ SymI_HasProto(connect) \
+ SymI_HasProto(htons) \
+ SymI_HasProto(ntohs) \
+ SymI_HasProto(getservbyname) \
+ SymI_HasProto(getservbyport) \
+ SymI_HasProto(getprotobynumber) \
+ SymI_HasProto(getprotobyname) \
+ SymI_HasProto(gethostbyname) \
+ SymI_HasProto(gethostbyaddr) \
+ SymI_HasProto(gethostname) \
+ SymI_HasProto(strcpy) \
+ SymI_HasProto(strncpy) \
+ SymI_HasProto(abort) \
+ SymI_NeedsProto(_alloca) \
+ SymI_HasProto(isxdigit) \
+ SymI_HasProto(isupper) \
+ SymI_HasProto(ispunct) \
+ SymI_HasProto(islower) \
+ SymI_HasProto(isspace) \
+ SymI_HasProto(isprint) \
+ SymI_HasProto(isdigit) \
+ SymI_HasProto(iscntrl) \
+ SymI_HasProto(isalpha) \
+ SymI_HasProto(isalnum) \
+ SymI_HasProto(isascii) \
+ RTS___MINGW_VFPRINTF_SYM \
+ SymI_HasProto(strcmp) \
+ SymI_HasProto(memmove) \
+ SymI_HasProto(realloc) \
+ SymI_HasProto(malloc) \
+ SymI_HasProto(pow) \
+ SymI_HasProto(tanh) \
+ SymI_HasProto(cosh) \
+ SymI_HasProto(sinh) \
+ SymI_HasProto(atan) \
+ SymI_HasProto(acos) \
+ SymI_HasProto(asin) \
+ SymI_HasProto(tan) \
+ SymI_HasProto(cos) \
+ SymI_HasProto(sin) \
+ SymI_HasProto(exp) \
+ SymI_HasProto(log) \
+ SymI_HasProto(sqrt) \
+ SymI_HasProto(powf) \
+ SymI_HasProto(tanhf) \
+ SymI_HasProto(coshf) \
+ SymI_HasProto(sinhf) \
+ SymI_HasProto(atanf) \
+ SymI_HasProto(acosf) \
+ SymI_HasProto(asinf) \
+ SymI_HasProto(tanf) \
+ SymI_HasProto(cosf) \
+ SymI_HasProto(sinf) \
+ SymI_HasProto(expf) \
+ SymI_HasProto(logf) \
+ SymI_HasProto(sqrtf) \
+ SymI_HasProto(erf) \
+ SymI_HasProto(erfc) \
+ SymI_HasProto(erff) \
+ SymI_HasProto(erfcf) \
+ SymI_HasProto(memcpy) \
+ SymI_HasProto(rts_InstallConsoleEvent) \
+ SymI_HasProto(rts_ConsoleHandlerDone) \
+ SymI_NeedsProto(mktime) \
+ SymI_NeedsProto(_imp___timezone) \
+ SymI_NeedsProto(_imp___tzname) \
+ SymI_NeedsProto(_imp__tzname) \
+ SymI_NeedsProto(_imp___iob) \
+ SymI_NeedsProto(_imp___osver) \
+ SymI_NeedsProto(localtime) \
+ SymI_NeedsProto(gmtime) \
+ SymI_NeedsProto(opendir) \
+ SymI_NeedsProto(readdir) \
+ SymI_NeedsProto(rewinddir) \
+ SymI_NeedsProto(_imp____mb_cur_max) \
+ SymI_NeedsProto(_imp___pctype) \
+ SymI_NeedsProto(__chkstk) \
+ RTS_MINGW_GETTIMEOFDAY_SYM \
+ SymI_NeedsProto(closedir)
+#endif
+
+
+#if defined(darwin_HOST_OS) && HAVE_PRINTF_LDBLSTUB
+#define RTS_DARWIN_ONLY_SYMBOLS \
+ SymI_NeedsProto(asprintf$LDBLStub) \
+ SymI_NeedsProto(err$LDBLStub) \
+ SymI_NeedsProto(errc$LDBLStub) \
+ SymI_NeedsProto(errx$LDBLStub) \
+ SymI_NeedsProto(fprintf$LDBLStub) \
+ SymI_NeedsProto(fscanf$LDBLStub) \
+ SymI_NeedsProto(fwprintf$LDBLStub) \
+ SymI_NeedsProto(fwscanf$LDBLStub) \
+ SymI_NeedsProto(printf$LDBLStub) \
+ SymI_NeedsProto(scanf$LDBLStub) \
+ SymI_NeedsProto(snprintf$LDBLStub) \
+ SymI_NeedsProto(sprintf$LDBLStub) \
+ SymI_NeedsProto(sscanf$LDBLStub) \
+ SymI_NeedsProto(strtold$LDBLStub) \
+ SymI_NeedsProto(swprintf$LDBLStub) \
+ SymI_NeedsProto(swscanf$LDBLStub) \
+ SymI_NeedsProto(syslog$LDBLStub) \
+ SymI_NeedsProto(vasprintf$LDBLStub) \
+ SymI_NeedsProto(verr$LDBLStub) \
+ SymI_NeedsProto(verrc$LDBLStub) \
+ SymI_NeedsProto(verrx$LDBLStub) \
+ SymI_NeedsProto(vfprintf$LDBLStub) \
+ SymI_NeedsProto(vfscanf$LDBLStub) \
+ SymI_NeedsProto(vfwprintf$LDBLStub) \
+ SymI_NeedsProto(vfwscanf$LDBLStub) \
+ SymI_NeedsProto(vprintf$LDBLStub) \
+ SymI_NeedsProto(vscanf$LDBLStub) \
+ SymI_NeedsProto(vsnprintf$LDBLStub) \
+ SymI_NeedsProto(vsprintf$LDBLStub) \
+ SymI_NeedsProto(vsscanf$LDBLStub) \
+ SymI_NeedsProto(vswprintf$LDBLStub) \
+ SymI_NeedsProto(vswscanf$LDBLStub) \
+ SymI_NeedsProto(vsyslog$LDBLStub) \
+ SymI_NeedsProto(vwarn$LDBLStub) \
+ SymI_NeedsProto(vwarnc$LDBLStub) \
+ SymI_NeedsProto(vwarnx$LDBLStub) \
+ SymI_NeedsProto(vwprintf$LDBLStub) \
+ SymI_NeedsProto(vwscanf$LDBLStub) \
+ SymI_NeedsProto(warn$LDBLStub) \
+ SymI_NeedsProto(warnc$LDBLStub) \
+ SymI_NeedsProto(warnx$LDBLStub) \
+ SymI_NeedsProto(wcstold$LDBLStub) \
+ SymI_NeedsProto(wprintf$LDBLStub) \
+ SymI_NeedsProto(wscanf$LDBLStub)
#else
#define RTS_DARWIN_ONLY_SYMBOLS
#endif
#ifndef SMP
-# define MAIN_CAP_SYM SymX(MainCapability)
+# define MAIN_CAP_SYM SymI_HasProto(MainCapability)
#else
# define MAIN_CAP_SYM
#endif
#if !defined(mingw32_HOST_OS)
-#define RTS_USER_SIGNALS_SYMBOLS \
- SymX(setIOManagerPipe)
+#define RTS_USER_SIGNALS_SYMBOLS \
+ SymI_HasProto(setIOManagerControlFd) \
+ SymI_HasProto(setIOManagerWakeupFd) \
+ SymI_HasProto(ioManagerWakeup) \
+ SymI_HasProto(blockUserSignals) \
+ SymI_HasProto(unblockUserSignals)
#else
-#define RTS_USER_SIGNALS_SYMBOLS \
- SymX(sendIOManagerEvent) \
- SymX(readIOManagerEvent) \
- SymX(getIOManagerEvent) \
- SymX(console_handler)
+#define RTS_USER_SIGNALS_SYMBOLS \
+ SymI_HasProto(ioManagerWakeup) \
+ SymI_HasProto(sendIOManagerEvent) \
+ SymI_HasProto(readIOManagerEvent) \
+ SymI_HasProto(getIOManagerEvent) \
+ SymI_HasProto(console_handler)
#endif
+#define RTS_LIBFFI_SYMBOLS \
+ 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)
-#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) \
- 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(noDuplicatezh_fast) \
- SymX(atomicModifyMutVarzh_fast) \
- SymX(newPinnedByteArrayzh_fast) \
- SymX(newSpark) \
- SymX(orIntegerzh_fast) \
- SymX(performGC) \
- SymX(performMajorGC) \
- SymX(plusIntegerzh_fast) \
- SymX(prog_argc) \
- SymX(prog_argv) \
- SymX(putMVarzh_fast) \
- SymX(quotIntegerzh_fast) \
- SymX(quotRemIntegerzh_fast) \
- SymX(raisezh_fast) \
- SymX(raiseIOzh_fast) \
- SymX(readTVarzh_fast) \
- SymX(remIntegerzh_fast) \
- SymX(resetNonBlockingFd) \
- SymX(resumeThread) \
- SymX(resolveObjs) \
- SymX(retryzh_fast) \
- SymX(rts_apply) \
- SymX(rts_checkSchedStatus) \
- SymX(rts_eval) \
- SymX(rts_evalIO) \
- SymX(rts_evalLazyIO) \
- SymX(rts_evalStableIO) \
- SymX(rts_eval_) \
- SymX(rts_getBool) \
- SymX(rts_getChar) \
- SymX(rts_getDouble) \
- SymX(rts_getFloat) \
- SymX(rts_getInt) \
- SymX(rts_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(allocateExec) \
- SymX(freeExec) \
- SymX(getAllocations) \
- SymX(revertCAFs) \
- SymX(RtsFlags) \
- RTS_USER_SIGNALS_SYMBOLS
-
-#ifdef SUPPORT_LONG_LONGS
-#define RTS_LONG_LONG_SYMS \
- SymX(int64ToIntegerzh_fast) \
- SymX(word64ToIntegerzh_fast)
+#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
+
+/* Modules compiled with -ticky may mention ticky counters */
+/* This list should marry up with the one in $(TOP)/includes/stg/Ticky.h */
+#define RTS_TICKY_SYMBOLS \
+ SymI_NeedsProto(ticky_entry_ctrs) \
+ SymI_NeedsProto(top_ct) \
+ \
+ SymI_HasProto(ENT_VIA_NODE_ctr) \
+ SymI_HasProto(ENT_STATIC_THK_ctr) \
+ SymI_HasProto(ENT_DYN_THK_ctr) \
+ SymI_HasProto(ENT_STATIC_FUN_DIRECT_ctr) \
+ SymI_HasProto(ENT_DYN_FUN_DIRECT_ctr) \
+ SymI_HasProto(ENT_STATIC_CON_ctr) \
+ SymI_HasProto(ENT_DYN_CON_ctr) \
+ SymI_HasProto(ENT_STATIC_IND_ctr) \
+ SymI_HasProto(ENT_DYN_IND_ctr) \
+ SymI_HasProto(ENT_PERM_IND_ctr) \
+ SymI_HasProto(ENT_PAP_ctr) \
+ SymI_HasProto(ENT_AP_ctr) \
+ SymI_HasProto(ENT_AP_STACK_ctr) \
+ SymI_HasProto(ENT_BH_ctr) \
+ SymI_HasProto(UNKNOWN_CALL_ctr) \
+ SymI_HasProto(SLOW_CALL_v_ctr) \
+ SymI_HasProto(SLOW_CALL_f_ctr) \
+ SymI_HasProto(SLOW_CALL_d_ctr) \
+ SymI_HasProto(SLOW_CALL_l_ctr) \
+ SymI_HasProto(SLOW_CALL_n_ctr) \
+ SymI_HasProto(SLOW_CALL_p_ctr) \
+ SymI_HasProto(SLOW_CALL_pv_ctr) \
+ SymI_HasProto(SLOW_CALL_pp_ctr) \
+ SymI_HasProto(SLOW_CALL_ppv_ctr) \
+ SymI_HasProto(SLOW_CALL_ppp_ctr) \
+ SymI_HasProto(SLOW_CALL_pppv_ctr) \
+ SymI_HasProto(SLOW_CALL_pppp_ctr) \
+ SymI_HasProto(SLOW_CALL_ppppp_ctr) \
+ SymI_HasProto(SLOW_CALL_pppppp_ctr) \
+ SymI_HasProto(SLOW_CALL_OTHER_ctr) \
+ SymI_HasProto(ticky_slow_call_unevald) \
+ SymI_HasProto(SLOW_CALL_ctr) \
+ SymI_HasProto(MULTI_CHUNK_SLOW_CALL_ctr) \
+ SymI_HasProto(MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr) \
+ SymI_HasProto(KNOWN_CALL_ctr) \
+ SymI_HasProto(KNOWN_CALL_TOO_FEW_ARGS_ctr) \
+ SymI_HasProto(KNOWN_CALL_EXTRA_ARGS_ctr) \
+ SymI_HasProto(SLOW_CALL_FUN_TOO_FEW_ctr) \
+ SymI_HasProto(SLOW_CALL_FUN_CORRECT_ctr) \
+ SymI_HasProto(SLOW_CALL_FUN_TOO_MANY_ctr) \
+ SymI_HasProto(SLOW_CALL_PAP_TOO_FEW_ctr) \
+ SymI_HasProto(SLOW_CALL_PAP_CORRECT_ctr) \
+ SymI_HasProto(SLOW_CALL_PAP_TOO_MANY_ctr) \
+ SymI_HasProto(SLOW_CALL_UNEVALD_ctr) \
+ SymI_HasProto(UPDF_OMITTED_ctr) \
+ SymI_HasProto(UPDF_PUSHED_ctr) \
+ SymI_HasProto(CATCHF_PUSHED_ctr) \
+ SymI_HasProto(UPDF_RCC_PUSHED_ctr) \
+ SymI_HasProto(UPDF_RCC_OMITTED_ctr) \
+ SymI_HasProto(UPD_SQUEEZED_ctr) \
+ SymI_HasProto(UPD_CON_IN_NEW_ctr) \
+ SymI_HasProto(UPD_CON_IN_PLACE_ctr) \
+ SymI_HasProto(UPD_PAP_IN_NEW_ctr) \
+ SymI_HasProto(UPD_PAP_IN_PLACE_ctr) \
+ SymI_HasProto(ALLOC_HEAP_ctr) \
+ SymI_HasProto(ALLOC_HEAP_tot) \
+ SymI_HasProto(ALLOC_FUN_ctr) \
+ SymI_HasProto(ALLOC_FUN_adm) \
+ SymI_HasProto(ALLOC_FUN_gds) \
+ SymI_HasProto(ALLOC_FUN_slp) \
+ SymI_HasProto(UPD_NEW_IND_ctr) \
+ SymI_HasProto(UPD_NEW_PERM_IND_ctr) \
+ SymI_HasProto(UPD_OLD_IND_ctr) \
+ SymI_HasProto(UPD_OLD_PERM_IND_ctr) \
+ SymI_HasProto(UPD_BH_UPDATABLE_ctr) \
+ SymI_HasProto(UPD_BH_SINGLE_ENTRY_ctr) \
+ SymI_HasProto(UPD_CAF_BH_UPDATABLE_ctr) \
+ SymI_HasProto(UPD_CAF_BH_SINGLE_ENTRY_ctr) \
+ SymI_HasProto(GC_SEL_ABANDONED_ctr) \
+ SymI_HasProto(GC_SEL_MINOR_ctr) \
+ SymI_HasProto(GC_SEL_MAJOR_ctr) \
+ SymI_HasProto(GC_FAILED_PROMOTION_ctr) \
+ SymI_HasProto(ALLOC_UP_THK_ctr) \
+ SymI_HasProto(ALLOC_SE_THK_ctr) \
+ SymI_HasProto(ALLOC_THK_adm) \
+ SymI_HasProto(ALLOC_THK_gds) \
+ SymI_HasProto(ALLOC_THK_slp) \
+ SymI_HasProto(ALLOC_CON_ctr) \
+ SymI_HasProto(ALLOC_CON_adm) \
+ SymI_HasProto(ALLOC_CON_gds) \
+ SymI_HasProto(ALLOC_CON_slp) \
+ SymI_HasProto(ALLOC_TUP_ctr) \
+ SymI_HasProto(ALLOC_TUP_adm) \
+ SymI_HasProto(ALLOC_TUP_gds) \
+ SymI_HasProto(ALLOC_TUP_slp) \
+ SymI_HasProto(ALLOC_BH_ctr) \
+ SymI_HasProto(ALLOC_BH_adm) \
+ SymI_HasProto(ALLOC_BH_gds) \
+ SymI_HasProto(ALLOC_BH_slp) \
+ SymI_HasProto(ALLOC_PRIM_ctr) \
+ SymI_HasProto(ALLOC_PRIM_adm) \
+ SymI_HasProto(ALLOC_PRIM_gds) \
+ SymI_HasProto(ALLOC_PRIM_slp) \
+ SymI_HasProto(ALLOC_PAP_ctr) \
+ SymI_HasProto(ALLOC_PAP_adm) \
+ SymI_HasProto(ALLOC_PAP_gds) \
+ SymI_HasProto(ALLOC_PAP_slp) \
+ SymI_HasProto(ALLOC_TSO_ctr) \
+ SymI_HasProto(ALLOC_TSO_adm) \
+ SymI_HasProto(ALLOC_TSO_gds) \
+ SymI_HasProto(ALLOC_TSO_slp) \
+ SymI_HasProto(RET_NEW_ctr) \
+ SymI_HasProto(RET_OLD_ctr) \
+ SymI_HasProto(RET_UNBOXED_TUP_ctr) \
+ SymI_HasProto(RET_SEMI_loads_avoided)
+
+
+// On most platforms, the garbage collector rewrites references
+// to small integer and char objects to a set of common, shared ones.
+//
+// We don't do this when compiling to Windows DLLs at the moment because
+// it doesn't support cross package data references well.
+//
+#if defined(__PIC__) && defined(mingw32_HOST_OS)
+#define RTS_INTCHAR_SYMBOLS
#else
-#define RTS_LONG_LONG_SYMS /* nothing */
+#define RTS_INTCHAR_SYMBOLS \
+ SymI_HasProto(stg_CHARLIKE_closure) \
+ SymI_HasProto(stg_INTLIKE_closure)
#endif
+
+#define RTS_SYMBOLS \
+ Maybe_Stable_Names \
+ RTS_TICKY_SYMBOLS \
+ SymI_HasProto(StgReturn) \
+ SymI_HasProto(stg_enter_info) \
+ SymI_HasProto(stg_gc_void_info) \
+ SymI_HasProto(__stg_gc_enter_1) \
+ SymI_HasProto(stg_gc_noregs) \
+ SymI_HasProto(stg_gc_unpt_r1_info) \
+ SymI_HasProto(stg_gc_unpt_r1) \
+ SymI_HasProto(stg_gc_unbx_r1_info) \
+ SymI_HasProto(stg_gc_unbx_r1) \
+ SymI_HasProto(stg_gc_f1_info) \
+ SymI_HasProto(stg_gc_f1) \
+ SymI_HasProto(stg_gc_d1_info) \
+ SymI_HasProto(stg_gc_d1) \
+ SymI_HasProto(stg_gc_l1_info) \
+ SymI_HasProto(stg_gc_l1) \
+ SymI_HasProto(__stg_gc_fun) \
+ SymI_HasProto(stg_gc_fun_info) \
+ SymI_HasProto(stg_gc_gen) \
+ SymI_HasProto(stg_gc_gen_info) \
+ SymI_HasProto(stg_gc_gen_hp) \
+ SymI_HasProto(stg_gc_ut) \
+ SymI_HasProto(stg_gen_yield) \
+ SymI_HasProto(stg_yield_noregs) \
+ SymI_HasProto(stg_yield_to_interpreter) \
+ SymI_HasProto(stg_gen_block) \
+ SymI_HasProto(stg_block_noregs) \
+ SymI_HasProto(stg_block_1) \
+ SymI_HasProto(stg_block_takemvar) \
+ SymI_HasProto(stg_block_putmvar) \
+ MAIN_CAP_SYM \
+ SymI_HasProto(MallocFailHook) \
+ SymI_HasProto(OnExitHook) \
+ SymI_HasProto(OutOfHeapHook) \
+ SymI_HasProto(StackOverflowHook) \
+ SymI_HasProto(addDLL) \
+ SymI_HasProto(__int_encodeDouble) \
+ SymI_HasProto(__word_encodeDouble) \
+ SymI_HasProto(__2Int_encodeDouble) \
+ SymI_HasProto(__int_encodeFloat) \
+ SymI_HasProto(__word_encodeFloat) \
+ SymI_HasProto(stg_atomicallyzh) \
+ SymI_HasProto(barf) \
+ SymI_HasProto(debugBelch) \
+ SymI_HasProto(errorBelch) \
+ SymI_HasProto(sysErrorBelch) \
+ SymI_HasProto(stg_getMaskingStatezh) \
+ SymI_HasProto(stg_maskAsyncExceptionszh) \
+ SymI_HasProto(stg_maskUninterruptiblezh) \
+ SymI_HasProto(stg_catchzh) \
+ SymI_HasProto(stg_catchRetryzh) \
+ SymI_HasProto(stg_catchSTMzh) \
+ SymI_HasProto(stg_checkzh) \
+ SymI_HasProto(closure_flags) \
+ SymI_HasProto(cmp_thread) \
+ SymI_HasProto(createAdjustor) \
+ SymI_HasProto(stg_decodeDoublezu2Intzh) \
+ SymI_HasProto(stg_decodeFloatzuIntzh) \
+ SymI_HasProto(defaultsHook) \
+ SymI_HasProto(stg_delayzh) \
+ SymI_HasProto(stg_deRefWeakzh) \
+ SymI_HasProto(stg_deRefStablePtrzh) \
+ SymI_HasProto(dirty_MUT_VAR) \
+ SymI_HasProto(stg_forkzh) \
+ SymI_HasProto(stg_forkOnzh) \
+ SymI_HasProto(forkProcess) \
+ SymI_HasProto(forkOS_createThread) \
+ SymI_HasProto(freeHaskellFunctionPtr) \
+ SymI_HasProto(getOrSetTypeableStore) \
+ SymI_HasProto(getOrSetGHCConcSignalSignalHandlerStore) \
+ SymI_HasProto(getOrSetGHCConcWindowsPendingDelaysStore) \
+ SymI_HasProto(getOrSetGHCConcWindowsIOManagerThreadStore) \
+ SymI_HasProto(getOrSetGHCConcWindowsProddingStore) \
+ SymI_HasProto(getOrSetSystemEventThreadEventManagerStore) \
+ SymI_HasProto(getOrSetSystemEventThreadIOManagerThreadStore) \
+ SymI_HasProto(genSymZh) \
+ SymI_HasProto(genericRaise) \
+ SymI_HasProto(getProgArgv) \
+ SymI_HasProto(getFullProgArgv) \
+ SymI_HasProto(getStablePtr) \
+ SymI_HasProto(hs_init) \
+ SymI_HasProto(hs_exit) \
+ SymI_HasProto(hs_set_argv) \
+ SymI_HasProto(hs_add_root) \
+ SymI_HasProto(hs_perform_gc) \
+ SymI_HasProto(hs_free_stable_ptr) \
+ SymI_HasProto(hs_free_fun_ptr) \
+ SymI_HasProto(hs_hpc_rootModule) \
+ SymI_HasProto(hs_hpc_module) \
+ SymI_HasProto(initLinker) \
+ SymI_HasProto(stg_unpackClosurezh) \
+ SymI_HasProto(stg_getApStackValzh) \
+ SymI_HasProto(stg_getSparkzh) \
+ SymI_HasProto(stg_numSparkszh) \
+ SymI_HasProto(stg_isCurrentThreadBoundzh) \
+ SymI_HasProto(stg_isEmptyMVarzh) \
+ SymI_HasProto(stg_killThreadzh) \
+ SymI_HasProto(loadArchive) \
+ SymI_HasProto(loadObj) \
+ SymI_HasProto(insertStableSymbol) \
+ SymI_HasProto(insertSymbol) \
+ SymI_HasProto(lookupSymbol) \
+ SymI_HasProto(stg_makeStablePtrzh) \
+ SymI_HasProto(stg_mkApUpd0zh) \
+ SymI_HasProto(stg_myThreadIdzh) \
+ SymI_HasProto(stg_labelThreadzh) \
+ SymI_HasProto(stg_newArrayzh) \
+ SymI_HasProto(stg_newBCOzh) \
+ SymI_HasProto(stg_newByteArrayzh) \
+ SymI_HasProto_redirect(newCAF, newDynCAF) \
+ SymI_HasProto(stg_newMVarzh) \
+ SymI_HasProto(stg_newMutVarzh) \
+ SymI_HasProto(stg_newTVarzh) \
+ SymI_HasProto(stg_noDuplicatezh) \
+ SymI_HasProto(stg_atomicModifyMutVarzh) \
+ SymI_HasProto(stg_casMutVarzh) \
+ SymI_HasProto(stg_newPinnedByteArrayzh) \
+ SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \
+ SymI_HasProto(newSpark) \
+ SymI_HasProto(performGC) \
+ SymI_HasProto(performMajorGC) \
+ SymI_HasProto(prog_argc) \
+ SymI_HasProto(prog_argv) \
+ SymI_HasProto(stg_putMVarzh) \
+ SymI_HasProto(stg_raisezh) \
+ SymI_HasProto(stg_raiseIOzh) \
+ SymI_HasProto(stg_readTVarzh) \
+ SymI_HasProto(stg_readTVarIOzh) \
+ SymI_HasProto(resumeThread) \
+ SymI_HasProto(resolveObjs) \
+ SymI_HasProto(stg_retryzh) \
+ SymI_HasProto(rts_apply) \
+ SymI_HasProto(rts_checkSchedStatus) \
+ SymI_HasProto(rts_eval) \
+ SymI_HasProto(rts_evalIO) \
+ SymI_HasProto(rts_evalLazyIO) \
+ SymI_HasProto(rts_evalStableIO) \
+ SymI_HasProto(rts_eval_) \
+ SymI_HasProto(rts_getBool) \
+ SymI_HasProto(rts_getChar) \
+ SymI_HasProto(rts_getDouble) \
+ SymI_HasProto(rts_getFloat) \
+ SymI_HasProto(rts_getInt) \
+ SymI_HasProto(rts_getInt8) \
+ SymI_HasProto(rts_getInt16) \
+ SymI_HasProto(rts_getInt32) \
+ SymI_HasProto(rts_getInt64) \
+ SymI_HasProto(rts_getPtr) \
+ SymI_HasProto(rts_getFunPtr) \
+ SymI_HasProto(rts_getStablePtr) \
+ SymI_HasProto(rts_getThreadId) \
+ SymI_HasProto(rts_getWord) \
+ SymI_HasProto(rts_getWord8) \
+ SymI_HasProto(rts_getWord16) \
+ SymI_HasProto(rts_getWord32) \
+ SymI_HasProto(rts_getWord64) \
+ SymI_HasProto(rts_lock) \
+ SymI_HasProto(rts_mkBool) \
+ SymI_HasProto(rts_mkChar) \
+ SymI_HasProto(rts_mkDouble) \
+ SymI_HasProto(rts_mkFloat) \
+ SymI_HasProto(rts_mkInt) \
+ SymI_HasProto(rts_mkInt8) \
+ SymI_HasProto(rts_mkInt16) \
+ SymI_HasProto(rts_mkInt32) \
+ SymI_HasProto(rts_mkInt64) \
+ SymI_HasProto(rts_mkPtr) \
+ SymI_HasProto(rts_mkFunPtr) \
+ SymI_HasProto(rts_mkStablePtr) \
+ SymI_HasProto(rts_mkString) \
+ SymI_HasProto(rts_mkWord) \
+ SymI_HasProto(rts_mkWord8) \
+ SymI_HasProto(rts_mkWord16) \
+ SymI_HasProto(rts_mkWord32) \
+ SymI_HasProto(rts_mkWord64) \
+ SymI_HasProto(rts_unlock) \
+ SymI_HasProto(rts_unsafeGetMyCapability) \
+ SymI_HasProto(rtsSupportsBoundThreads) \
+ SymI_HasProto(rts_isProfiled) \
+ SymI_HasProto(setProgArgv) \
+ SymI_HasProto(startupHaskell) \
+ SymI_HasProto(shutdownHaskell) \
+ SymI_HasProto(shutdownHaskellAndExit) \
+ SymI_HasProto(stable_ptr_table) \
+ SymI_HasProto(stackOverflow) \
+ SymI_HasProto(stg_CAF_BLACKHOLE_info) \
+ SymI_HasProto(stg_BLACKHOLE_info) \
+ SymI_HasProto(__stg_EAGER_BLACKHOLE_info) \
+ SymI_HasProto(stg_BLOCKING_QUEUE_CLEAN_info) \
+ SymI_HasProto(stg_BLOCKING_QUEUE_DIRTY_info) \
+ SymI_HasProto(startTimer) \
+ SymI_HasProto(stg_MVAR_CLEAN_info) \
+ SymI_HasProto(stg_MVAR_DIRTY_info) \
+ SymI_HasProto(stg_IND_STATIC_info) \
+ SymI_HasProto(stg_ARR_WORDS_info) \
+ SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info) \
+ SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info) \
+ SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN0_info) \
+ SymI_HasProto(stg_WEAK_info) \
+ SymI_HasProto(stg_ap_v_info) \
+ SymI_HasProto(stg_ap_f_info) \
+ SymI_HasProto(stg_ap_d_info) \
+ SymI_HasProto(stg_ap_l_info) \
+ SymI_HasProto(stg_ap_n_info) \
+ SymI_HasProto(stg_ap_p_info) \
+ SymI_HasProto(stg_ap_pv_info) \
+ SymI_HasProto(stg_ap_pp_info) \
+ SymI_HasProto(stg_ap_ppv_info) \
+ SymI_HasProto(stg_ap_ppp_info) \
+ SymI_HasProto(stg_ap_pppv_info) \
+ SymI_HasProto(stg_ap_pppp_info) \
+ SymI_HasProto(stg_ap_ppppp_info) \
+ SymI_HasProto(stg_ap_pppppp_info) \
+ SymI_HasProto(stg_ap_0_fast) \
+ SymI_HasProto(stg_ap_v_fast) \
+ SymI_HasProto(stg_ap_f_fast) \
+ SymI_HasProto(stg_ap_d_fast) \
+ SymI_HasProto(stg_ap_l_fast) \
+ SymI_HasProto(stg_ap_n_fast) \
+ SymI_HasProto(stg_ap_p_fast) \
+ SymI_HasProto(stg_ap_pv_fast) \
+ SymI_HasProto(stg_ap_pp_fast) \
+ SymI_HasProto(stg_ap_ppv_fast) \
+ SymI_HasProto(stg_ap_ppp_fast) \
+ SymI_HasProto(stg_ap_pppv_fast) \
+ SymI_HasProto(stg_ap_pppp_fast) \
+ SymI_HasProto(stg_ap_ppppp_fast) \
+ SymI_HasProto(stg_ap_pppppp_fast) \
+ SymI_HasProto(stg_ap_1_upd_info) \
+ SymI_HasProto(stg_ap_2_upd_info) \
+ SymI_HasProto(stg_ap_3_upd_info) \
+ SymI_HasProto(stg_ap_4_upd_info) \
+ SymI_HasProto(stg_ap_5_upd_info) \
+ SymI_HasProto(stg_ap_6_upd_info) \
+ SymI_HasProto(stg_ap_7_upd_info) \
+ SymI_HasProto(stg_exit) \
+ SymI_HasProto(stg_sel_0_upd_info) \
+ SymI_HasProto(stg_sel_10_upd_info) \
+ SymI_HasProto(stg_sel_11_upd_info) \
+ SymI_HasProto(stg_sel_12_upd_info) \
+ SymI_HasProto(stg_sel_13_upd_info) \
+ SymI_HasProto(stg_sel_14_upd_info) \
+ SymI_HasProto(stg_sel_15_upd_info) \
+ SymI_HasProto(stg_sel_1_upd_info) \
+ SymI_HasProto(stg_sel_2_upd_info) \
+ SymI_HasProto(stg_sel_3_upd_info) \
+ SymI_HasProto(stg_sel_4_upd_info) \
+ SymI_HasProto(stg_sel_5_upd_info) \
+ SymI_HasProto(stg_sel_6_upd_info) \
+ SymI_HasProto(stg_sel_7_upd_info) \
+ SymI_HasProto(stg_sel_8_upd_info) \
+ SymI_HasProto(stg_sel_9_upd_info) \
+ SymI_HasProto(stg_upd_frame_info) \
+ SymI_HasProto(stg_bh_upd_frame_info) \
+ SymI_HasProto(suspendThread) \
+ SymI_HasProto(stg_takeMVarzh) \
+ SymI_HasProto(stg_threadStatuszh) \
+ SymI_HasProto(stg_tryPutMVarzh) \
+ SymI_HasProto(stg_tryTakeMVarzh) \
+ SymI_HasProto(stg_unmaskAsyncExceptionszh) \
+ SymI_HasProto(unloadObj) \
+ SymI_HasProto(stg_unsafeThawArrayzh) \
+ SymI_HasProto(stg_waitReadzh) \
+ SymI_HasProto(stg_waitWritezh) \
+ SymI_HasProto(stg_writeTVarzh) \
+ SymI_HasProto(stg_yieldzh) \
+ SymI_NeedsProto(stg_interp_constr_entry) \
+ SymI_HasProto(stg_arg_bitmaps) \
+ SymI_HasProto(large_alloc_lim) \
+ SymI_HasProto(g0) \
+ SymI_HasProto(allocate) \
+ SymI_HasProto(allocateExec) \
+ SymI_HasProto(freeExec) \
+ SymI_HasProto(getAllocations) \
+ SymI_HasProto(revertCAFs) \
+ SymI_HasProto(RtsFlags) \
+ SymI_NeedsProto(rts_breakpoint_io_action) \
+ SymI_NeedsProto(rts_stop_next_breakpoint) \
+ SymI_NeedsProto(rts_stop_on_exception) \
+ SymI_HasProto(stopTimer) \
+ SymI_HasProto(n_capabilities) \
+ SymI_HasProto(stg_traceCcszh) \
+ SymI_HasProto(stg_traceEventzh) \
+ RTS_USER_SIGNALS_SYMBOLS \
+ RTS_INTCHAR_SYMBOLS
+
+
// 64-bit support functions in libgcc.a
#if defined(__GNUC__) && SIZEOF_VOID_P <= 4
-#define RTS_LIBGCC_SYMBOLS \
- Sym(__divdi3) \
- Sym(__udivdi3) \
- Sym(__moddi3) \
- Sym(__umoddi3) \
- Sym(__muldi3) \
- Sym(__ashldi3) \
- Sym(__ashrdi3) \
- Sym(__lshrdi3) \
- Sym(__eprintf)
-#elif defined(ia64_HOST_ARCH)
-#define RTS_LIBGCC_SYMBOLS \
- Sym(__divdi3) \
- Sym(__udivdi3) \
- Sym(__moddi3) \
- Sym(__umoddi3) \
- Sym(__divsf3) \
- Sym(__divdf3)
+#define RTS_LIBGCC_SYMBOLS \
+ SymI_NeedsProto(__divdi3) \
+ SymI_NeedsProto(__udivdi3) \
+ SymI_NeedsProto(__moddi3) \
+ SymI_NeedsProto(__umoddi3) \
+ SymI_NeedsProto(__muldi3) \
+ SymI_NeedsProto(__ashldi3) \
+ SymI_NeedsProto(__ashrdi3) \
+ SymI_NeedsProto(__lshrdi3)
#else
#define RTS_LIBGCC_SYMBOLS
#endif
// Symbols that don't have a leading underscore
// on Mac OS X. They have to receive special treatment,
// see machoInitSymbolsWithoutUnderscore()
-#define RTS_MACHO_NOUNDERLINE_SYMBOLS \
- Sym(saveFP) \
- Sym(restFP)
+#define RTS_MACHO_NOUNDERLINE_SYMBOLS \
+ 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_HOST_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)
#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
HashTable *table,
char* key,
void *data
- )
+ )
{
if (lookupHashTable(table, (StgWord)key) == NULL)
{
(char*)key,
obj_name
);
- exit(1);
+ stg_exit(1);
}
/* -----------------------------------------------------------------------------
* initialize the object linker
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
static void *dl_prog_handle;
+static regex_t re_invalid;
+static regex_t re_realso;
+#ifdef THREADED_RTS
+static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
+#endif
#endif
void
initLinker( void )
{
RtsSymbolVal *sym;
+#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+ int compileResult;
+#endif
+
+ IF_DEBUG(linker, debugBelch("initLinker: start\n"));
/* Make initLinker idempotent, so we can call it
before evey relevant operation; that means we
don't need to initialise the linker separately */
- if (linker_init_done == 1) { return; } else {
- linker_init_done = 1;
+ if (linker_init_done == 1) {
+ IF_DEBUG(linker, debugBelch("initLinker: idempotent return\n"));
+ return;
+ } else {
+ linker_init_done = 1;
}
+#if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO))
+ initMutex(&dl_mutex);
+#endif
stablehash = allocStrHashTable();
symhash = allocStrHashTable();
/* populate the symbol table with stuff from the RTS */
for (sym = rtsSyms; sym->lbl != NULL; sym++) {
- ghciInsertStrHashTable("(GHCi built-in symbols)",
+ ghciInsertStrHashTable("(GHCi built-in symbols)",
symhash, sym->lbl, sym->addr);
+ IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr));
}
# if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
machoInitSymbolsWithoutUnderscore();
# else
dl_prog_handle = dlopen(NULL, RTLD_LAZY);
# endif /* RTLD_DEFAULT */
+
+ compileResult = regcomp(&re_invalid,
+ "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*(invalid ELF header|file too short)",
+ REG_EXTENDED);
+ ASSERT( compileResult == 0 );
+ compileResult = regcomp(&re_realso,
+ "(GROUP|INPUT) *\\( *(([^ )])+)",
+ REG_EXTENDED);
+ ASSERT( compileResult == 0 );
# endif
+
+#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
+ if (RtsFlags.MiscFlags.linkerMemBase != 0) {
+ // User-override for mmap_32bit_base
+ mmap_32bit_base = (void*)RtsFlags.MiscFlags.linkerMemBase;
+ }
+#endif
+
+#if defined(mingw32_HOST_OS)
+ /*
+ * These two libraries cause problems when added to the static link,
+ * but are necessary for resolving symbols in GHCi, hence we load
+ * them manually here.
+ */
+ addDLL("msvcrt");
+ addDLL("kernel32");
+#endif
+
+ IF_DEBUG(linker, debugBelch("initLinker: done\n"));
+ return;
+}
+
+void
+exitLinker( void ) {
+#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+ if (linker_init_done == 1) {
+ regfree(&re_invalid);
+ regfree(&re_realso);
+#ifdef THREADED_RTS
+ closeMutex(&dl_mutex);
+#endif
+ }
+#endif
}
/* -----------------------------------------------------------------------------
static OpenedDLL* opened_dlls = NULL;
#endif
-char *
-addDLL( char *dll_name )
-{
# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
- /* ------------------- ELF DLL loader ------------------- */
+
+static const char *
+internal_dlopen(const char *dll_name)
+{
void *hdl;
- char *errmsg;
+ const char *errmsg;
+ char *errmsg_copy;
- initLinker();
+ // omitted: RTLD_NOW
+ // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
+ IF_DEBUG(linker,
+ debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name));
+
+ //-------------- Begin critical section ------------------
+ // This critical section is necessary because dlerror() is not
+ // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008)
+ // Also, the error message returned must be copied to preserve it
+ // (see POSIX also)
- hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
+ ACQUIRE_LOCK(&dl_mutex);
+ hdl = dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
+ errmsg = NULL;
if (hdl == NULL) {
/* dlopen failed; return a ptr to the error msg. */
errmsg = dlerror();
if (errmsg == NULL) errmsg = "addDLL: unknown error";
- return errmsg;
- } else {
+ errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL");
+ strcpy(errmsg_copy, errmsg);
+ errmsg = errmsg_copy;
+ }
+ RELEASE_LOCK(&dl_mutex);
+ //--------------- End critical section -------------------
+
+ return errmsg;
+}
+# endif
+
+const char *
+addDLL( char *dll_name )
+{
+# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+ /* ------------------- ELF DLL loader ------------------- */
+
+#define NMATCH 5
+ regmatch_t match[NMATCH];
+ const char *errmsg;
+ FILE* fp;
+ size_t match_length;
+#define MAXLINE 1000
+ char line[MAXLINE];
+ int result;
+
+ initLinker();
+
+ IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name));
+ errmsg = internal_dlopen(dll_name);
+
+ if (errmsg == NULL) {
return NULL;
}
- /*NOTREACHED*/
+
+ // GHC Trac ticket #2615
+ // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so)
+ // contain linker scripts rather than ELF-format object code. This
+ // code handles the situation by recognizing the real object code
+ // file name given in the linker script.
+ //
+ // If an "invalid ELF header" error occurs, it is assumed that the
+ // .so file contains a linker script instead of ELF object code.
+ // In this case, the code looks for the GROUP ( ... ) linker
+ // directive. If one is found, the first file name inside the
+ // parentheses is treated as the name of a dynamic library and the
+ // code attempts to dlopen that file. If this is also unsuccessful,
+ // an error message is returned.
+
+ // see if the error message is due to an invalid ELF header
+ IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg));
+ result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0);
+ IF_DEBUG(linker, debugBelch("result = %i\n", result));
+ if (result == 0) {
+ // success -- try to read the named file as a linker script
+ match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so),
+ MAXLINE-1);
+ strncpy(line, (errmsg+(match[1].rm_so)),match_length);
+ line[match_length] = '\0'; // make sure string is null-terminated
+ IF_DEBUG(linker, debugBelch ("file name = '%s'\n", line));
+ if ((fp = fopen(line, "r")) == NULL) {
+ return errmsg; // return original error if open fails
+ }
+ // try to find a GROUP ( ... ) command
+ while (fgets(line, MAXLINE, fp) != NULL) {
+ IF_DEBUG(linker, debugBelch("input line = %s", line));
+ if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
+ // success -- try to dlopen the first named file
+ IF_DEBUG(linker, debugBelch("match%s\n",""));
+ line[match[2].rm_eo] = '\0';
+ errmsg = internal_dlopen(line+match[2].rm_so);
+ break;
+ }
+ // if control reaches here, no GROUP ( ... ) directive was found
+ // and the original error message is returned to the caller
+ }
+ fclose(fp);
+ }
+ return errmsg;
# elif defined(OBJFORMAT_PEi386)
/* ------------------- Win32 DLL loader ------------------- */
both foo.dll and foo.drv
The documentation for LoadLibrary says:
- If no file name extension is specified in the lpFileName
- parameter, the default library extension .dll is
- appended. However, the file name string can include a trailing
- point character (.) to indicate that the module name has no
- extension. */
+ If no file name extension is specified in the lpFileName
+ parameter, the default library extension .dll is
+ appended. However, the file name string can include a trailing
+ point character (.) to indicate that the module name has no
+ extension. */
buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
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);
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
lookupSymbol( char *lbl )
{
void *val;
+ IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl));
initLinker() ;
ASSERT(symhash != NULL);
val = lookupStrHashTable(symhash, lbl);
if (val == NULL) {
+ IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n"));
# if defined(OBJFORMAT_ELF)
-# 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
+ return dlsym(dl_prog_handle, lbl);
# elif defined(OBJFORMAT_MACHO)
- if(NSIsSymbolNameDefined(lbl)) {
- NSSymbol symbol = NSLookupAndBindSymbol(lbl);
- return NSAddressOfSymbol(symbol);
- } else {
- return NULL;
- }
+# 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).
+ */
+ IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n", lbl));
+ 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((unsigned char*)lbl);
+ if (sym != NULL) { return sym; };
+
+ // Also try looking up the symbol without the @N suffix. Some
+ // DLLs have the suffixes on their symbols, some don't.
+ zapTrailingAtSign ( (unsigned char*)lbl );
+ sym = lookupSymbolInDLLs((unsigned char*)lbl);
+ if (sym != NULL) { return sym; };
return NULL;
+
# else
ASSERT(2+2 == 5);
return NULL;
# endif
} else {
- return val;
- }
-}
-
-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;
+ IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p\n", lbl, val));
+ return val;
}
}
-
/* -----------------------------------------------------------------------------
* Debugging aid: look in GHCi's object symbol tables for symbols
* within DELTA bytes of the specified address, and show their names.
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);
- }
+ }
if (a == NULL) {
- // debugBelch("ghci_enquire: can't find %s\n", sym);
+ // debugBelch("ghci_enquire: can't find %s\n", sym);
}
else if (addr-DELTA <= a && a <= addr+DELTA) {
debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym);
}
#endif
-#ifdef ia64_HOST_ARCH
-static unsigned int PLTSize(void);
-#endif
+#ifdef USE_MMAP
+#define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
-/* -----------------------------------------------------------------------------
- * Load an obj (populate the global symbol table, but don't resolve yet)
- *
- * Returns: 1 if ok, 0 on error.
- */
-HsInt
-loadObj( char *path )
+static void *
+mmapForLinker (size_t bytes, nat flags, int fd)
{
- ObjectCode* oc;
- struct stat st;
- int r, n;
-#ifdef USE_MMAP
- int fd, pagesize;
void *map_addr = NULL;
-#else
- FILE *f;
+ void *result;
+ int pagesize, size;
+ static nat fixed = 0;
+
+ IF_DEBUG(linker, debugBelch("mmapForLinker: start\n"));
+ pagesize = getpagesize();
+ size = ROUND_UP(bytes, pagesize);
+
+#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
+mmap_again:
+
+ if (mmap_32bit_base != 0) {
+ map_addr = mmap_32bit_base;
+ }
#endif
- initLinker();
- /* debugBelch("loadObj %s\n", path ); */
+ IF_DEBUG(linker, debugBelch("mmapForLinker: \tprotection %#0x\n", PROT_EXEC | PROT_READ | PROT_WRITE));
+ IF_DEBUG(linker, debugBelch("mmapForLinker: \tflags %#0x\n", MAP_PRIVATE | TRY_MAP_32BIT | fixed | flags));
+ result = mmap(map_addr, size, PROT_EXEC|PROT_READ|PROT_WRITE,
+ MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, 0);
- /* Check that we haven't already loaded this object.
- Ignore requests to load multiple times */
- {
- ObjectCode *o;
- int is_dup = 0;
- for (o = objects; o; o = o->next) {
- if (0 == strcmp(o->fileName, path)) {
- is_dup = 1;
- break; /* don't need to search further */
- }
+ if (result == MAP_FAILED) {
+ sysErrorBelch("mmap %lu bytes at %p",(lnat)size,map_addr);
+ errorBelch("Try specifying an address with +RTS -xm<addr> -RTS");
+ stg_exit(EXIT_FAILURE);
+ }
+
+#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
+ if (mmap_32bit_base != 0) {
+ if (result == map_addr) {
+ mmap_32bit_base = (StgWord8*)map_addr + size;
+ } else {
+ if ((W_)result > 0x80000000) {
+ // oops, we were given memory over 2Gb
+#if defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) || defined(dragonfly_HOST_OS)
+ // Some platforms require MAP_FIXED. This is normally
+ // a bad idea, because MAP_FIXED will overwrite
+ // existing mappings.
+ munmap(result,size);
+ fixed = MAP_FIXED;
+ goto mmap_again;
+#else
+ barf("loadObj: failed to mmap() memory below 2Gb; asked for %lu bytes at %p. Try specifying an address with +RTS -xm<addr> -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;
+ }
}
- if (is_dup) {
- IF_DEBUG(linker, debugBelch(
- "GHCi runtime linker: warning: looks like you're trying to load the\n"
- "same object file twice:\n"
- " %s\n"
- "GHCi will ignore this, but be warned.\n"
- , path));
- return 1; /* success */
+ } 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
+
+ IF_DEBUG(linker, debugBelch("mmapForLinker: mapped %lu bytes starting at %p\n", (lnat)size, result));
+ IF_DEBUG(linker, debugBelch("mmapForLinker: done\n"));
+ return result;
+}
+#endif // USE_MMAP
+
+static ObjectCode*
+mkOc( char *path, char *image, int imageSize,
+ char *archiveMemberName
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ , int misalignment
+#endif
+#endif
+ ) {
+ ObjectCode* oc;
- oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
+ IF_DEBUG(linker, debugBelch("mkOc: start\n"));
+ oc = stgMallocBytes(sizeof(ObjectCode), "loadArchive(oc)");
# if defined(OBJFORMAT_ELF)
oc->formatName = "ELF";
barf("loadObj: not implemented on this platform");
# endif
- r = stat(path, &st);
- if (r == -1) { return 0; }
-
+ oc->image = image;
/* sigh, strdup() isn't a POSIX function, so do it the long way */
oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
strcpy(oc->fileName, path);
- oc->fileSize = st.st_size;
+ if (archiveMemberName) {
+ oc->archiveMemberName = stgMallocBytes( strlen(archiveMemberName)+1, "loadObj" );
+ strcpy(oc->archiveMemberName, archiveMemberName);
+ }
+ else {
+ oc->archiveMemberName = NULL;
+ }
+
+ oc->fileSize = imageSize;
oc->symbols = NULL;
oc->sections = NULL;
- oc->lochash = allocStrHashTable();
oc->proddables = NULL;
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ oc->misalignment = misalignment;
+#endif
+#endif
+
/* chain it onto the list of objects */
oc->next = objects;
objects = oc;
-#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_DEBUG(linker, debugBelch("mkOc: done\n"));
+ return oc;
+}
-#if defined(openbsd_HOST_OS)
- fd = open(path, O_RDONLY, S_IRUSR);
+HsInt
+loadArchive( char *path )
+{
+ ObjectCode* oc;
+ char *image;
+ int memberSize;
+ FILE *f;
+ int n;
+ size_t thisFileNameSize;
+ char *fileName;
+ size_t fileNameSize;
+ int isObject, isGnuIndex;
+ char tmp[20];
+ char *gnuFileIndex;
+ int gnuFileIndexSize;
+#if defined(darwin_HOST_OS)
+ int i;
+ uint32_t nfat_arch, nfat_offset, cputype, cpusubtype;
+#if defined(i386_HOST_ARCH)
+ const uint32_t mycputype = CPU_TYPE_X86;
+ const uint32_t mycpusubtype = CPU_SUBTYPE_X86_ALL;
+#elif defined(x86_64_HOST_ARCH)
+ const uint32_t mycputype = CPU_TYPE_X86_64;
+ const uint32_t mycpusubtype = CPU_SUBTYPE_X86_64_ALL;
+#elif defined(powerpc_HOST_ARCH)
+ const uint32_t mycputype = CPU_TYPE_POWERPC;
+ const uint32_t mycpusubtype = CPU_SUBTYPE_POWERPC_ALL;
+#elif defined(powerpc64_HOST_ARCH)
+ const uint32_t mycputype = CPU_TYPE_POWERPC64;
+ const uint32_t mycpusubtype = CPU_SUBTYPE_POWERPC_ALL;
#else
- fd = open(path, O_RDONLY);
+#error Unknown Darwin architecture
+#endif
+#if !defined(USE_MMAP)
+ int misalignment;
+#endif
#endif
- 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");
+ IF_DEBUG(linker, debugBelch("loadArchive: start\n"));
+ IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%s'\n", path));
+
+ gnuFileIndex = NULL;
+ gnuFileIndexSize = 0;
+
+ fileNameSize = 32;
+ fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)");
+
+ f = fopen(path, "rb");
+ if (!f)
+ barf("loadObj: can't read `%s'", path);
+
+ /* Check if this is an archive by looking for the magic "!<arch>\n"
+ * string. Usually, if this fails, we barf and quit. On Darwin however,
+ * we may have a fat archive, which contains archives for more than
+ * one architecture. Fat archives start with the magic number 0xcafebabe,
+ * always stored big endian. If we find a fat_header, we scan through
+ * the fat_arch structs, searching through for one for our host
+ * architecture. If a matching struct is found, we read the offset
+ * of our archive data (nfat_offset) and seek forward nfat_offset bytes
+ * from the start of the file.
+ *
+ * A subtlety is that all of the members of the fat_header and fat_arch
+ * structs are stored big endian, so we need to call byte order
+ * conversion functions.
+ *
+ * If we find the appropriate architecture in a fat archive, we gobble
+ * its magic "!<arch>\n" string and continue processing just as if
+ * we had a single architecture archive.
+ */
- oc->pltIndex = 0;
- map_addr = oc->plt + n;
-#endif
+ n = fread ( tmp, 1, 8, f );
+ if (n != 8)
+ barf("loadArchive: Failed reading header from `%s'", path);
+ if (strncmp(tmp, "!<arch>\n", 8) != 0) {
+
+#if defined(darwin_HOST_OS)
+ /* Not a standard archive, look for a fat archive magic number: */
+ if (ntohl(*(uint32_t *)tmp) == FAT_MAGIC) {
+ nfat_arch = ntohl(*(uint32_t *)(tmp + 4));
+ IF_DEBUG(linker, debugBelch("loadArchive: found a fat archive containing %d architectures\n", nfat_arch));
+ nfat_offset = 0;
+
+ for (i = 0; i < (int)nfat_arch; i++) {
+ /* search for the right arch */
+ n = fread( tmp, 1, 20, f );
+ if (n != 8)
+ barf("loadArchive: Failed reading arch from `%s'", path);
+ cputype = ntohl(*(uint32_t *)tmp);
+ cpusubtype = ntohl(*(uint32_t *)(tmp + 4));
+
+ if (cputype == mycputype && cpusubtype == mycpusubtype) {
+ IF_DEBUG(linker, debugBelch("loadArchive: found my archive in a fat archive\n"));
+ nfat_offset = ntohl(*(uint32_t *)(tmp + 8));
+ break;
+ }
+ }
- n = ROUND_UP(oc->fileSize, pagesize);
+ if (nfat_offset == 0) {
+ barf ("loadArchive: searched %d architectures, but no host arch found", (int)nfat_arch);
+ }
+ else {
+ n = fseek( f, nfat_offset, SEEK_SET );
+ if (n != 0)
+ barf("loadArchive: Failed to seek to arch in `%s'", path);
+ n = fread ( tmp, 1, 8, f );
+ if (n != 8)
+ barf("loadArchive: Failed reading header from `%s'", path);
+ if (strncmp(tmp, "!<arch>\n", 8) != 0) {
+ barf("loadArchive: couldn't find archive in `%s' at offset %d", path, nfat_offset);
+ }
+ }
+ }
+ else {
+ barf("loadArchive: Neither an archive, nor a fat archive: `%s'", path);
+ }
- /* 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
+ barf("loadArchive: Not an archive: `%s'", path);
#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);
-
- close(fd);
-
-#else /* !USE_MMAP */
-
- /* load the image into memory */
- f = fopen(path, "rb");
- if (!f)
- barf("loadObj: can't read `%s'", path);
+ IF_DEBUG(linker, debugBelch("loadArchive: loading archive contents\n"));
-# 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
- // as input for the static linker, but it's not fine for us,
- // as SSE (used by gcc for floating point) and Altivec require
- // 16-byte alignment.
- // We calculate the correct alignment from the header before
- // reading the file, and then we misalign oc->image on purpose so
- // that the actual sections end up aligned again.
- oc->misalignment = machoGetMisalignment(f);
- oc->image = stgMallocBytes(oc->fileSize + oc->misalignment, "loadObj(image)");
- oc->image += oc->misalignment;
-# else
- oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
-# endif
+ while(1) {
+ n = fread ( fileName, 1, 16, f );
+ if (n != 16) {
+ if (feof(f)) {
+ IF_DEBUG(linker, debugBelch("loadArchive: EOF while reading from '%s'\n", path));
+ break;
+ }
+ else {
+ barf("loadArchive: Failed reading file name from `%s'", path);
+ }
+ }
- n = fread ( oc->image, 1, oc->fileSize, f );
- if (n != oc->fileSize)
- barf("loadObj: error whilst reading `%s'", path);
+#if defined(darwin_HOST_OS)
+ if (strncmp(fileName, "!<arch>\n", 8) == 0) {
+ IF_DEBUG(linker, debugBelch("loadArchive: found the start of another archive, breaking\n"));
+ break;
+ }
+#endif
- fclose(f);
+ n = fread ( tmp, 1, 12, f );
+ if (n != 12)
+ barf("loadArchive: Failed reading mod time from `%s'", path);
+ n = fread ( tmp, 1, 6, f );
+ if (n != 6)
+ barf("loadArchive: Failed reading owner from `%s'", path);
+ n = fread ( tmp, 1, 6, f );
+ if (n != 6)
+ barf("loadArchive: Failed reading group from `%s'", path);
+ n = fread ( tmp, 1, 8, f );
+ if (n != 8)
+ barf("loadArchive: Failed reading mode from `%s'", path);
+ n = fread ( tmp, 1, 10, f );
+ if (n != 10)
+ barf("loadArchive: Failed reading size from `%s'", path);
+ tmp[10] = '\0';
+ for (n = 0; isdigit(tmp[n]); n++);
+ tmp[n] = '\0';
+ memberSize = atoi(tmp);
+
+ IF_DEBUG(linker, debugBelch("loadArchive: size of this archive member is %d\n", memberSize));
+ n = fread ( tmp, 1, 2, f );
+ if (n != 2)
+ barf("loadArchive: Failed reading magic from `%s'", path);
+ if (strncmp(tmp, "\x60\x0A", 2) != 0)
+ barf("loadArchive: Failed reading magic from `%s' at %ld. Got %c%c",
+ path, ftell(f), tmp[0], tmp[1]);
+
+ isGnuIndex = 0;
+ /* Check for BSD-variant large filenames */
+ if (0 == strncmp(fileName, "#1/", 3)) {
+ fileName[16] = '\0';
+ if (isdigit(fileName[3])) {
+ for (n = 4; isdigit(fileName[n]); n++);
+ fileName[n] = '\0';
+ thisFileNameSize = atoi(fileName + 3);
+ memberSize -= thisFileNameSize;
+ if (thisFileNameSize >= fileNameSize) {
+ /* Double it to avoid potentially continually
+ increasing it by 1 */
+ fileNameSize = thisFileNameSize * 2;
+ fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
+ }
+ n = fread ( fileName, 1, thisFileNameSize, f );
+ if (n != (int)thisFileNameSize) {
+ barf("loadArchive: Failed reading filename from `%s'",
+ path);
+ }
+ fileName[thisFileNameSize] = 0;
+ /* On OS X at least, thisFileNameSize is the size of the
+ fileName field, not the length of the fileName
+ itself. */
+ thisFileNameSize = strlen(fileName);
+ }
+ else {
+ barf("loadArchive: BSD-variant filename size not found while reading filename from `%s'", path);
+ }
+ }
+ /* Check for GNU file index file */
+ else if (0 == strncmp(fileName, "//", 2)) {
+ fileName[0] = '\0';
+ thisFileNameSize = 0;
+ isGnuIndex = 1;
+ }
+ /* Check for a file in the GNU file index */
+ else if (fileName[0] == '/') {
+ if (isdigit(fileName[1])) {
+ int i;
+
+ for (n = 2; isdigit(fileName[n]); n++);
+ fileName[n] = '\0';
+ n = atoi(fileName + 1);
+
+ if (gnuFileIndex == NULL) {
+ barf("loadArchive: GNU-variant filename without an index while reading from `%s'", path);
+ }
+ if (n < 0 || n > gnuFileIndexSize) {
+ barf("loadArchive: GNU-variant filename offset %d out of range [0..%d] while reading filename from `%s'", n, gnuFileIndexSize, path);
+ }
+ if (n != 0 && gnuFileIndex[n - 1] != '\n') {
+ barf("loadArchive: GNU-variant filename offset %d invalid (range [0..%d]) while reading filename from `%s'", n, gnuFileIndexSize, path);
+ }
+ for (i = n; gnuFileIndex[i] != '/'; i++);
+ thisFileNameSize = i - n;
+ if (thisFileNameSize >= fileNameSize) {
+ /* Double it to avoid potentially continually
+ increasing it by 1 */
+ fileNameSize = thisFileNameSize * 2;
+ fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
+ }
+ memcpy(fileName, gnuFileIndex + n, thisFileNameSize);
+ fileName[thisFileNameSize] = '\0';
+ }
+ else if (fileName[1] == ' ') {
+ fileName[0] = '\0';
+ thisFileNameSize = 0;
+ }
+ else {
+ barf("loadArchive: GNU-variant filename offset not found while reading filename from `%s'", path);
+ }
+ }
+ /* Finally, the case where the filename field actually contains
+ the filename */
+ else {
+ /* GNU ar terminates filenames with a '/', this allowing
+ spaces in filenames. So first look to see if there is a
+ terminating '/'. */
+ for (thisFileNameSize = 0;
+ thisFileNameSize < 16;
+ thisFileNameSize++) {
+ if (fileName[thisFileNameSize] == '/') {
+ fileName[thisFileNameSize] = '\0';
+ break;
+ }
+ }
+ /* If we didn't find a '/', then a space teminates the
+ filename. Note that if we don't find one, then
+ thisFileNameSize ends up as 16, and we already have the
+ '\0' at the end. */
+ if (thisFileNameSize == 16) {
+ for (thisFileNameSize = 0;
+ thisFileNameSize < 16;
+ thisFileNameSize++) {
+ if (fileName[thisFileNameSize] == ' ') {
+ fileName[thisFileNameSize] = '\0';
+ break;
+ }
+ }
+ }
+ }
+
+ IF_DEBUG(linker,
+ debugBelch("loadArchive: Found member file `%s'\n", fileName));
+
+ isObject = thisFileNameSize >= 2
+ && fileName[thisFileNameSize - 2] == '.'
+ && fileName[thisFileNameSize - 1] == 'o';
+
+ IF_DEBUG(linker, debugBelch("loadArchive: \tthisFileNameSize = %d\n", (int)thisFileNameSize));
+ IF_DEBUG(linker, debugBelch("loadArchive: \tisObject = %d\n", isObject));
+
+ if (isObject) {
+ char *archiveMemberName;
+
+ IF_DEBUG(linker, debugBelch("loadArchive: Member is an object file...loading...\n"));
+
+ /* We can't mmap from the archive directly, as object
+ files need to be 8-byte aligned but files in .ar
+ archives are 2-byte aligned. When possible we use mmap
+ to get some anonymous memory, as on 64-bit platforms if
+ we use malloc then we can be given memory above 2^32.
+ In the mmap case we're probably wasting lots of space;
+ we could do better. */
+#if defined(USE_MMAP)
+ image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1);
+#elif defined(darwin_HOST_OS)
+ /* See loadObj() */
+ misalignment = machoGetMisalignment(f);
+ image = stgMallocBytes(memberSize + misalignment, "loadArchive(image)");
+ image += misalignment;
+#else
+ image = stgMallocBytes(memberSize, "loadArchive(image)");
+#endif
+ n = fread ( image, 1, memberSize, f );
+ if (n != memberSize) {
+ barf("loadArchive: error whilst reading `%s'", path);
+ }
+
+ archiveMemberName = stgMallocBytes(strlen(path) + thisFileNameSize + 3,
+ "loadArchive(file)");
+ sprintf(archiveMemberName, "%s(%.*s)",
+ path, (int)thisFileNameSize, fileName);
+
+ oc = mkOc(path, image, memberSize, archiveMemberName
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ , misalignment
+#endif
+#endif
+ );
+
+ stgFree(archiveMemberName);
+
+ if (0 == loadOc(oc)) {
+ stgFree(fileName);
+ return 0;
+ }
+ }
+ else if (isGnuIndex) {
+ if (gnuFileIndex != NULL) {
+ barf("loadArchive: GNU-variant index found, but already have an index, while reading filename from `%s'", path);
+ }
+ IF_DEBUG(linker, debugBelch("loadArchive: Found GNU-variant file index\n"));
+#ifdef USE_MMAP
+ gnuFileIndex = mmapForLinker(memberSize + 1, MAP_ANONYMOUS, -1);
+#else
+ gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)");
+#endif
+ n = fread ( gnuFileIndex, 1, memberSize, f );
+ if (n != memberSize) {
+ barf("loadArchive: error whilst reading `%s'", path);
+ }
+ gnuFileIndex[memberSize] = '/';
+ gnuFileIndexSize = memberSize;
+ }
+ else {
+ IF_DEBUG(linker, debugBelch("loadArchive: '%s' does not appear to be an object file\n", fileName));
+ n = fseek(f, memberSize, SEEK_CUR);
+ if (n != 0)
+ barf("loadArchive: error whilst seeking by %d in `%s'",
+ memberSize, path);
+ }
+
+ /* .ar files are 2-byte aligned */
+ if (memberSize % 2) {
+ IF_DEBUG(linker, debugBelch("loadArchive: trying to read one pad byte\n"));
+ n = fread ( tmp, 1, 1, f );
+ if (n != 1) {
+ if (feof(f)) {
+ IF_DEBUG(linker, debugBelch("loadArchive: found EOF while reading one pad byte\n"));
+ break;
+ }
+ else {
+ barf("loadArchive: Failed reading padding from `%s'", path);
+ }
+ }
+ IF_DEBUG(linker, debugBelch("loadArchive: successfully read one pad byte\n"));
+ }
+ IF_DEBUG(linker, debugBelch("loadArchive: reached end of archive loading while loop\n"));
+ }
+
+ fclose(f);
+
+ stgFree(fileName);
+ if (gnuFileIndex != NULL) {
+#ifdef USE_MMAP
+ munmap(gnuFileIndex, gnuFileIndexSize + 1);
+#else
+ stgFree(gnuFileIndex);
+#endif
+ }
+
+ IF_DEBUG(linker, debugBelch("loadArchive: done\n"));
+ return 1;
+}
+
+/* -----------------------------------------------------------------------------
+ * Load an obj (populate the global symbol table, but don't resolve yet)
+ *
+ * Returns: 1 if ok, 0 on error.
+ */
+HsInt
+loadObj( char *path )
+{
+ ObjectCode* oc;
+ char *image;
+ int fileSize;
+ struct stat st;
+ int r;
+#ifdef USE_MMAP
+ int fd;
+#else
+ FILE *f;
+# if defined(darwin_HOST_OS)
+ int misalignment;
+# endif
+#endif
+ IF_DEBUG(linker, debugBelch("loadObj %s\n", path));
+
+ initLinker();
+
+ /* debugBelch("loadObj %s\n", path ); */
+
+ /* Check that we haven't already loaded this object.
+ Ignore requests to load multiple times */
+ {
+ ObjectCode *o;
+ int is_dup = 0;
+ for (o = objects; o; o = o->next) {
+ if (0 == strcmp(o->fileName, path)) {
+ is_dup = 1;
+ break; /* don't need to search further */
+ }
+ }
+ if (is_dup) {
+ IF_DEBUG(linker, debugBelch(
+ "GHCi runtime linker: warning: looks like you're trying to load the\n"
+ "same object file twice:\n"
+ " %s\n"
+ "GHCi will ignore this, but be warned.\n"
+ , path));
+ return 1; /* success */
+ }
+ }
+
+ r = stat(path, &st);
+ if (r == -1) {
+ IF_DEBUG(linker, debugBelch("File doesn't exist\n"));
+ return 0;
+ }
+
+ fileSize = st.st_size;
+
+#ifdef USE_MMAP
+ /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
+
+#if defined(openbsd_HOST_OS)
+ fd = open(path, O_RDONLY, S_IRUSR);
+#else
+ fd = open(path, O_RDONLY);
+#endif
+ if (fd == -1)
+ barf("loadObj: can't open `%s'", path);
+
+ image = mmapForLinker(fileSize, 0, fd);
+
+ close(fd);
+
+#else /* !USE_MMAP */
+ /* load the image into memory */
+ f = fopen(path, "rb");
+ if (!f)
+ barf("loadObj: can't read `%s'", path);
+
+# if defined(mingw32_HOST_OS)
+ // TODO: We would like to use allocateExec here, but allocateExec
+ // cannot currently allocate blocks large enough.
+ image = VirtualAlloc(NULL, fileSize, MEM_RESERVE | MEM_COMMIT,
+ PAGE_EXECUTE_READWRITE);
+# elif defined(darwin_HOST_OS)
+ // In a Mach-O .o file, all sections can and will be misaligned
+ // if the total size of the headers is not a multiple of the
+ // desired alignment. This is fine for .o files that only serve
+ // as input for the static linker, but it's not fine for us,
+ // as SSE (used by gcc for floating point) and Altivec require
+ // 16-byte alignment.
+ // We calculate the correct alignment from the header before
+ // reading the file, and then we misalign image on purpose so
+ // that the actual sections end up aligned again.
+ misalignment = machoGetMisalignment(f);
+ image = stgMallocBytes(fileSize + misalignment, "loadObj(image)");
+ image += misalignment;
+# else
+ image = stgMallocBytes(fileSize, "loadObj(image)");
+# endif
+
+ {
+ int n;
+ n = fread ( image, 1, fileSize, f );
+ if (n != 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 (!r) { return r; }
-# elif defined(OBJFORMAT_ELF) && defined(powerpc_HOST_ARCH)
- r = ocAllocateJumpIslands_ELF ( oc );
- if (!r) { return r; }
+ oc = mkOc(path, image, fileSize, NULL
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ , misalignment
+#endif
+#endif
+ );
+
+ return loadOc(oc);
+}
+
+static HsInt
+loadOc( ObjectCode* oc ) {
+ int r;
+
+ IF_DEBUG(linker, debugBelch("loadOc: start\n"));
+
+# if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
+ r = ocAllocateSymbolExtras_MachO ( oc );
+ if (!r) {
+ IF_DEBUG(linker, debugBelch("loadOc: ocAllocateSymbolExtras_MachO failed\n"));
+ return r;
+ }
+# elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
+ r = ocAllocateSymbolExtras_ELF ( oc );
+ if (!r) {
+ IF_DEBUG(linker, debugBelch("loadOc: ocAllocateSymbolExtras_ELF failed\n"));
+ return r;
+ }
#endif
/* verify the in-memory image */
# else
barf("loadObj: no verify method");
# endif
- if (!r) { return r; }
+ if (!r) {
+ IF_DEBUG(linker, debugBelch("loadOc: ocVerifyImage_* failed\n"));
+ return r;
+ }
/* build the symbol list for this image */
# if defined(OBJFORMAT_ELF)
# else
barf("loadObj: no getNames method");
# endif
- if (!r) { return r; }
+ if (!r) {
+ IF_DEBUG(linker, debugBelch("loadOc: ocGetNames_* failed\n"));
+ return r;
+ }
/* loaded, but not resolved yet */
oc->status = OBJECT_LOADED;
+ IF_DEBUG(linker, debugBelch("loadOc: done.\n"));
return 1;
}
ObjectCode *oc;
int r;
+ IF_DEBUG(linker, debugBelch("resolveObjs: start\n"));
initLinker();
for (oc = objects; oc; oc = oc->next) {
- if (oc->status != OBJECT_RESOLVED) {
+ if (oc->status != OBJECT_RESOLVED) {
# if defined(OBJFORMAT_ELF)
- r = ocResolve_ELF ( oc );
+ r = ocResolve_ELF ( oc );
# elif defined(OBJFORMAT_PEi386)
- r = ocResolve_PEi386 ( oc );
+ r = ocResolve_PEi386 ( oc );
# elif defined(OBJFORMAT_MACHO)
- r = ocResolve_MachO ( oc );
+ r = ocResolve_MachO ( oc );
# else
- barf("resolveObjs: not implemented on this platform");
+ barf("resolveObjs: not implemented on this platform");
# endif
- if (!r) { return r; }
- oc->status = OBJECT_RESOLVED;
- }
+ if (!r) { return r; }
+ oc->status = OBJECT_RESOLVED;
+ }
}
+ IF_DEBUG(linker, debugBelch("resolveObjs: done\n"));
return 1;
}
unloadObj( char *path )
{
ObjectCode *oc, *prev;
+ HsBool unloadedAnyObj = HS_BOOL_FALSE;
ASSERT(symhash != NULL);
ASSERT(objects != NULL);
prev = NULL;
for (oc = objects; oc; prev = oc, oc = oc->next) {
- if (!strcmp(oc->fileName,path)) {
+ if (!strcmp(oc->fileName,path)) {
- /* Remove all the mappings for the symbols within this
- * object..
- */
- {
+ /* Remove all the mappings for the symbols within this
+ * object..
+ */
+ {
int i;
for (i = 0; i < oc->n_symbols; i++) {
if (oc->symbols[i] != NULL) {
}
}
- if (prev == NULL) {
- objects = oc->next;
- } else {
- prev->next = oc->next;
- }
-
- // We're going to leave this in place, in case there are
- // any pointers from the heap into it:
- // #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;
- }
+ if (prev == NULL) {
+ objects = oc->next;
+ } else {
+ prev->next = oc->next;
+ }
+
+ // We're going to leave this in place, in case there are
+ // any pointers from the heap into it:
+ // #ifdef mingw32_HOST_OS
+ // VirtualFree(oc->image);
+ // #else
+ // stgFree(oc->image);
+ // #endif
+ stgFree(oc->fileName);
+ stgFree(oc->archiveMemberName);
+ stgFree(oc->symbols);
+ stgFree(oc->sections);
+ stgFree(oc);
+
+ /* This could be a member of an archive so continue
+ * unloading other members. */
+ unloadedAnyObj = HS_BOOL_TRUE;
+ }
}
- errorBelch("unloadObj: can't find `%s' to unload", path);
- return 0;
+ if (unloadedAnyObj) {
+ return 1;
+ }
+ else {
+ errorBelch("unloadObj: can't find `%s' to unload", path);
+ return 0;
+ }
}
/* -----------------------------------------------------------------------------
* which may be prodded during relocation, and abort if we try and write
* outside any of these.
*/
-static void addProddableBlock ( ObjectCode* oc, void* start, int size )
+static void
+addProddableBlock ( ObjectCode* oc, void* start, int size )
{
ProddableBlock* pb
= stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
- /* debugBelch("aPB %p %p %d\n", oc, start, size); */
+
+ IF_DEBUG(linker, debugBelch("addProddableBlock: %p %p %d\n", oc, start, size));
ASSERT(size > 0);
pb->start = start;
pb->size = size;
oc->proddables = pb;
}
-static void checkProddableBlock ( ObjectCode* oc, void* addr )
+static void
+checkProddableBlock (ObjectCode *oc, void *addr )
{
ProddableBlock* pb;
+
for (pb = oc->proddables; pb != NULL; pb = pb->next) {
char* s = (char*)(pb->start);
char* e = s + pb->size - 1;
/* -----------------------------------------------------------------------------
* Section management.
*/
-static void addSection ( ObjectCode* oc, SectionKind kind,
+static void
+addSection ( ObjectCode* oc, SectionKind kind,
void* start, void* end )
{
Section* s = stgMallocBytes(sizeof(Section), "addSection");
s->kind = kind;
s->next = oc->sections;
oc->sections = s;
- /*
- debugBelch("addSection: %p-%p (size %d), kind %d\n",
- start, ((char*)end)-1, end - start + 1, kind );
- */
+
+ IF_DEBUG(linker, debugBelch("addSection: %p-%p (size %ld), kind %d\n",
+ start, ((char*)end)-1, (long)end - (long)start + 1, 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 )
{
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" );
+ misalignment +
+ 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;
-
- return (unsigned long) island;
+ 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 extra;
}
+#endif
+
+/* --------------------------------------------------------------------------
+ * PowerPC specifics (instruction cache flushing)
+ * ------------------------------------------------------------------------*/
+
+#ifdef powerpc_HOST_ARCH
/*
ocFlushInstructionCache
do that whenever we modify code at runtime.
*/
-static void ocFlushInstructionCache( ObjectCode *oc )
+static void
+ocFlushInstructionCacheFrom(void* begin, size_t length)
{
- int n = (oc->fileSize + sizeof( ppcJumpIsland ) * oc->n_islands + 3) / 4;
- unsigned long *p = (unsigned long *) oc->image;
+ size_t n = (length + 3) / 4;
+ unsigned long* p = begin;
- while( n-- )
+ while (n--)
{
__asm__ volatile ( "dcbf 0,%0\n\t"
"sync\n\t"
"isync"
);
}
+
+static void
+ocFlushInstructionCache( ObjectCode *oc )
+{
+ /* The main object code */
+ ocFlushInstructionCacheFrom(oc->image
+#ifdef darwin_HOST_OS
+ + oc->misalignment
#endif
+ , oc->fileSize);
+
+ /* Jump Islands */
+ ocFlushInstructionCacheFrom(oc->symbol_extras, sizeof(SymbolExtra) * oc->n_symbol_extras);
+}
+#endif /* powerpc_HOST_ARCH */
+
/* --------------------------------------------------------------------------
* PEi386 specifics (Win32 targets)
{
if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
UInt32 strtab_offset = * (UInt32*)(name+4);
- strncpy ( dst, strtab+strtab_offset, dstSize );
+ strncpy ( (char*)dst, (char*)strtab+strtab_offset, dstSize );
dst[dstSize-1] = 0;
} else {
int i = 0;
*/
if (name[7]==0) return name;
/* The annoying case: 8 bytes. Copy into a temporary
- (which is never freed ...)
+ (XXX which is never freed ...)
*/
newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
ASSERT(newstr);
- strncpy(newstr,name,8);
+ strncpy((char*)newstr,(char*)name,8);
newstr[8] = 0;
return newstr;
}
+/* Getting the name of a section is mildly tricky, so we make a
+ function for it. Sadly, in one case we have to copy the string
+ (when it is exactly 8 bytes long there's no trailing '\0'), so for
+ consistency we *always* copy the string; the caller must free it
+*/
+static char *
+cstring_from_section_name (UChar* name, UChar* strtab)
+{
+ char *newstr;
+
+ if (name[0]=='/') {
+ int strtab_offset = strtol((char*)name+1,NULL,10);
+ int len = strlen(((char*)strtab) + strtab_offset);
+
+ newstr = stgMallocBytes(len, "cstring_from_section_symbol_name");
+ strcpy((char*)newstr, (char*)((UChar*)strtab) + strtab_offset);
+ return newstr;
+ }
+ else
+ {
+ newstr = stgMallocBytes(9, "cstring_from_section_symbol_name");
+ ASSERT(newstr);
+ strncpy((char*)newstr,(char*)name,8);
+ newstr[8] = 0;
+ return newstr;
+ }
+}
/* Just compares the short names (first 8 chars) */
static COFF_section *
-findPEi386SectionCalled ( ObjectCode* oc, char* name )
+findPEi386SectionCalled ( ObjectCode* oc, UChar* name )
{
int i;
COFF_header* hdr
# undef my_isdigit
}
+static void *
+lookupSymbolInDLLs ( UChar *lbl )
+{
+ OpenedDLL* o_dll;
+ void *sym;
+
+ for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
+ /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
+
+ if (lbl[0] == '_') {
+ /* HACK: if the name has an initial underscore, try stripping
+ it off & look that up first. I've yet to verify whether there's
+ a Rule that governs whether an initial '_' *should always* be
+ stripped off when mapping from import lib name to the DLL name.
+ */
+ sym = GetProcAddress(o_dll->instance, (char*)(lbl+1));
+ if (sym != NULL) {
+ /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
+ return sym;
+ }
+ }
+ sym = GetProcAddress(o_dll->instance, (char*)lbl);
+ if (sym != NULL) {
+ /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
+ return sym;
+ }
+ }
+ return NULL;
+}
+
static int
ocVerifyImage_PEi386 ( ObjectCode* oc )
if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
/* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
- oc->fileName,
- (int)(hdr->Characteristics));
+ oc->fileName,
+ (int)(hdr->Characteristics));
return 0;
}
/* If the string table size is way crazy, this might indicate that
);
if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
- /* If the relocation field (a short) has overflowed, the
- * real count can be found in the first reloc entry.
- *
- * See Section 4.1 (last para) of the PE spec (rev6.0).
- */
+ /* If the relocation field (a short) has overflowed, the
+ * real count can be found in the first reloc entry.
+ *
+ * See Section 4.1 (last para) of the PE spec (rev6.0).
+ */
COFF_reloc* rel = (COFF_reloc*)
myindex ( sizeof_COFF_reloc, reltab, 0 );
- noRelocs = rel->VirtualAddress;
- j = 1;
+ noRelocs = rel->VirtualAddress;
+ j = 1;
} else {
- noRelocs = sectab_i->NumberOfRelocations;
+ noRelocs = sectab_i->NumberOfRelocations;
j = 0;
}
rel->VirtualAddress );
sym = (COFF_symbol*)
myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
- /* Hmm..mysterious looking offset - what's it for? SOF */
+ /* Hmm..mysterious looking offset - what's it for? SOF */
printName ( sym->Name, strtab -10 );
debugBelch("'\n" );
}
COFF_section* sectab_i
= (COFF_section*)
myindex ( sizeof_COFF_section, sectab, i );
- if (0 != strcmp(sectab_i->Name, ".bss")) continue;
+
+ char *secname = cstring_from_section_name(sectab_i->Name, strtab);
+
+ if (0 != strcmp(secname, ".bss")) {
+ stgFree(secname);
+ continue;
+ }
+
+ stgFree(secname);
+
/* sof 10/05: the PE spec text isn't too clear regarding what
* the SizeOfRawData field is supposed to hold for object
* file sections containing just uninitialized data -- for executables,
COFF_section* sectab_i
= (COFF_section*)
myindex ( sizeof_COFF_section, sectab, i );
- IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
+
+ char *secname = cstring_from_section_name(sectab_i->Name, strtab);
+
+ IF_DEBUG(linker, debugBelch("section name = %s\n", secname ));
# if 0
/* I'm sure this is the Right Way to do it. However, the
kind = SECTIONKIND_CODE_OR_RODATA;
# endif
- if (0==strcmp(".text",sectab_i->Name) ||
- 0==strcmp(".rdata",sectab_i->Name)||
- 0==strcmp(".rodata",sectab_i->Name))
+ if (0==strcmp(".text",(char*)secname) ||
+ 0==strcmp(".rdata",(char*)secname)||
+ 0==strcmp(".rodata",(char*)secname))
kind = SECTIONKIND_CODE_OR_RODATA;
- if (0==strcmp(".data",sectab_i->Name) ||
- 0==strcmp(".bss",sectab_i->Name))
+ if (0==strcmp(".data",(char*)secname) ||
+ 0==strcmp(".bss",(char*)secname))
kind = SECTIONKIND_RWDATA;
ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
if (kind == SECTIONKIND_OTHER
/* Ignore sections called which contain stabs debugging
information. */
- && 0 != strcmp(".stab", sectab_i->Name)
- && 0 != strcmp(".stabstr", sectab_i->Name)
+ && 0 != strcmp(".stab", (char*)secname)
+ && 0 != strcmp(".stabstr", (char*)secname)
/* ignore constructor section for now */
- && 0 != strcmp(".ctors", sectab_i->Name)
+ && 0 != strcmp(".ctors", (char*)secname)
/* ignore section generated from .ident */
- && 0!= strcmp("/4", sectab_i->Name)
+ && 0!= strncmp(".debug", (char*)secname, 6)
+ /* ignore unknown section that appeared in gcc 3.4.5(?) */
+ && 0!= strcmp(".reloc", (char*)secname)
+ && 0 != strcmp(".rdata$zzz", (char*)secname)
) {
- errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
+ errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", secname, oc->fileName);
+ stgFree(secname);
return 0;
}
addSection(oc, kind, start, end);
addProddableBlock(oc, start, end - start + 1);
}
+
+ stgFree(secname);
}
/* Copy exported symbols into the ObjectCode. */
}
else
if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
- && symtab_i->Value > 0) {
+ && symtab_i->Value > 0) {
/* This symbol isn't in any section at all, ie, global bss.
Allocate zeroed space for it. */
addr = stgCallocBytes(1, symtab_i->Value,
IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
ASSERT(i >= 0 && i < oc->n_symbols);
/* cstring_from_COFF_symbol_name always succeeds. */
- oc->symbols[i] = sname;
- ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
+ oc->symbols[i] = (char*)sname;
+ ghciInsertStrHashTable(oc->fileName, symhash, (char*)sname, addr);
} else {
# if 0
debugBelch(
/* ToDo: should be variable-sized? But is at least safe in the
sense of buffer-overrun-proof. */
- char symbol[1000];
+ UChar symbol[1000];
/* debugBelch("resolving for %s\n", oc->fileName); */
hdr = (COFF_header*)(oc->image);
((UChar*)(oc->image)) + sectab_i->PointerToRelocations
);
+ char *secname = cstring_from_section_name(sectab_i->Name, strtab);
+
/* Ignore sections called which contain stabs debugging
information. */
- if (0 == strcmp(".stab", sectab_i->Name)
- || 0 == strcmp(".stabstr", sectab_i->Name)
- || 0 == strcmp(".ctors", sectab_i->Name))
- continue;
+ if (0 == strcmp(".stab", (char*)secname)
+ || 0 == strcmp(".stabstr", (char*)secname)
+ || 0 == strcmp(".ctors", (char*)secname)
+ || 0 == strncmp(".debug", (char*)secname, 6)
+ || 0 == strcmp(".rdata$zzz", (char*)secname)) {
+ stgFree(secname);
+ continue;
+ }
+
+ stgFree(secname);
if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
- /* If the relocation field (a short) has overflowed, the
- * real count can be found in the first reloc entry.
+ /* If the relocation field (a short) has overflowed, the
+ * real count can be found in the first reloc entry.
+ *
+ * See Section 4.1 (last para) of the PE spec (rev6.0).
*
- * See Section 4.1 (last para) of the PE spec (rev6.0).
- *
- * Nov2003 update: the GNU linker still doesn't correctly
- * handle the generation of relocatable object files with
- * overflown relocations. Hence the output to warn of potential
- * troubles.
- */
+ * Nov2003 update: the GNU linker still doesn't correctly
+ * handle the generation of relocatable object files with
+ * overflown relocations. Hence the output to warn of potential
+ * troubles.
+ */
COFF_reloc* rel = (COFF_reloc*)
myindex ( sizeof_COFF_reloc, reltab, 0 );
- noRelocs = rel->VirtualAddress;
+ noRelocs = rel->VirtualAddress;
- /* 10/05: we now assume (and check for) a GNU ld that is capable
- * of handling object files with (>2^16) of relocs.
- */
+ /* 10/05: we now assume (and check for) a GNU ld that is capable
+ * of handling object files with (>2^16) of relocs.
+ */
#if 0
- debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
- noRelocs);
+ debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
+ noRelocs);
#endif
- j = 1;
+ j = 1;
} else {
- noRelocs = sectab_i->NumberOfRelocations;
+ noRelocs = sectab_i->NumberOfRelocations;
j = 0;
}
+ sym->Value);
} else {
copyName ( sym->Name, strtab, symbol, 1000-1 );
- S = (UInt32) lookupLocalSymbol( oc, symbol );
+ S = (UInt32) lookupSymbol( (char*)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:;
}
Also I don't know if A should be added, but so
far it has always been zero.
- SOF 05/2005: 'A' (old contents of *pP) have been observed
- to contain values other than zero (the 'wx' object file
- that came with wxhaskell-0.9.4; dunno how it was compiled..).
- So, add displacement to old value instead of asserting
- A to be zero. Fixes wxhaskell-related crashes, and no other
- ill effects have been observed.
-
- Update: the reason why we're seeing these more elaborate
- relocations is due to a switch in how the NCG compiles SRTs
- and offsets to them from info tables. SRTs live in .(ro)data,
- while info tables live in .text, causing GAS to emit REL32/DISP32
- relocations with non-zero values. Adding the displacement is
- the right thing to do.
- */
+ SOF 05/2005: 'A' (old contents of *pP) have been observed
+ to contain values other than zero (the 'wx' object file
+ that came with wxhaskell-0.9.4; dunno how it was compiled..).
+ So, add displacement to old value instead of asserting
+ A to be zero. Fixes wxhaskell-related crashes, and no other
+ ill effects have been observed.
+
+ Update: the reason why we're seeing these more elaborate
+ relocations is due to a switch in how the NCG compiles SRTs
+ and offsets to them from info tables. SRTs live in .(ro)data,
+ while info tables live in .text, causing GAS to emit REL32/DISP32
+ relocations with non-zero values. Adding the displacement is
+ the right thing to do.
+ */
*pP = S - ((UInt32)pP) - 4 + A;
break;
default:
debugBelch("%s: unhandled PEi386 relocation type %d",
- oc->fileName, reltab_j->Type);
+ oc->fileName, reltab_j->Type);
return 0;
}
#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 <elf.h> */
-# 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 <elf.h>
+# include <elf.h>
#else
/* openbsd elf has things in different places, with diff names */
-#include <elf_abi.h>
-#include <machine/reloc.h>
-#define R_386_32 RELOC_32
-#define R_386_PC32 RELOC_PC32
+# include <elf_abi.h>
+# include <machine/reloc.h>
+# 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
*/
#define Elf_Sym Elf64_Sym
#define Elf_Rel Elf64_Rel
#define Elf_Rela Elf64_Rela
+#ifndef ELF_ST_TYPE
#define ELF_ST_TYPE ELF64_ST_TYPE
+#endif
+#ifndef ELF_ST_BIND
#define ELF_ST_BIND ELF64_ST_BIND
+#endif
+#ifndef ELF_R_TYPE
#define ELF_R_TYPE ELF64_R_TYPE
+#endif
+#ifndef ELF_R_SYM
#define ELF_R_SYM ELF64_R_SYM
+#endif
#else
#define ELFCLASS ELFCLASS32
#define Elf_Addr Elf32_Addr
#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)];
#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
*/
-static char *
-findElfSection ( void* objImage, Elf_Word sh_type )
-{
- char* ehdrC = (char*)objImage;
- Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
- Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
- char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
- char* ptr = NULL;
- int i;
-
- for (i = 0; i < ehdr->e_shnum; i++) {
- if (shdr[i].sh_type == sh_type
- /* Ignore the section header's string table. */
- && i != ehdr->e_shstrndx
- /* Ignore string tables named .stabstr, as they contain
- debugging info. */
- && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
- ) {
- ptr = ehdrC + shdr[i].sh_offset;
- break;
- }
- }
- 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 )
{
Elf_Sym* stab;
int i, j, nent, nstrtab, nsymtabs;
char* sh_strtab;
- char* strtab;
char* ehdrC = (char*)(oc->image);
Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
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;
}
IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
ehdrC + shdr[i].sh_offset,
- ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
+ ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
+
+#define SECTION_INDEX_VALID(ndx) (ndx > SHN_UNDEF && ndx < ehdr->e_shnum)
+
+ switch (shdr[i].sh_type) {
+
+ case SHT_REL:
+ case SHT_RELA:
+ IF_DEBUG(linker,debugBelch( shdr[i].sh_type == SHT_REL ? "Rel " : "RelA "));
+
+ if (!SECTION_INDEX_VALID(shdr[i].sh_link)) {
+ if (shdr[i].sh_link == SHN_UNDEF)
+ errorBelch("\n%s: relocation section #%d has no symbol table\n"
+ "This object file has probably been fully striped. "
+ "Such files cannot be linked.\n",
+ oc->archiveMemberName ? oc->archiveMemberName : oc->fileName, i);
+ else
+ errorBelch("\n%s: relocation section #%d has an invalid link field (%d)\n",
+ oc->archiveMemberName ? oc->archiveMemberName : oc->fileName,
+ i, shdr[i].sh_link);
+ return 0;
+ }
+ if (shdr[shdr[i].sh_link].sh_type != SHT_SYMTAB) {
+ errorBelch("\n%s: relocation section #%d does not link to a symbol table\n",
+ oc->archiveMemberName ? oc->archiveMemberName : oc->fileName, i);
+ return 0;
+ }
+ if (!SECTION_INDEX_VALID(shdr[i].sh_info)) {
+ errorBelch("\n%s: relocation section #%d has an invalid info field (%d)\n",
+ oc->archiveMemberName ? oc->archiveMemberName : oc->fileName,
+ i, shdr[i].sh_info);
+ return 0;
+ }
- if (shdr[i].sh_type == SHT_REL) {
- IF_DEBUG(linker,debugBelch("Rel " ));
- } else if (shdr[i].sh_type == SHT_RELA) {
- IF_DEBUG(linker,debugBelch("RelA " ));
- } else {
- IF_DEBUG(linker,debugBelch(" "));
+ break;
+ case SHT_SYMTAB:
+ IF_DEBUG(linker,debugBelch("Sym "));
+
+ if (!SECTION_INDEX_VALID(shdr[i].sh_link)) {
+ errorBelch("\n%s: symbol table section #%d has an invalid link field (%d)\n",
+ oc->archiveMemberName ? oc->archiveMemberName : oc->fileName,
+ i, shdr[i].sh_link);
+ return 0;
+ }
+ if (shdr[shdr[i].sh_link].sh_type != SHT_STRTAB) {
+ errorBelch("\n%s: symbol table section #%d does not link to a string table\n",
+ oc->archiveMemberName ? oc->archiveMemberName : oc->fileName, i);
+
+ return 0;
+ }
+ break;
+ case SHT_STRTAB: IF_DEBUG(linker,debugBelch("Str ")); break;
+ default: IF_DEBUG(linker,debugBelch(" ")); break;
}
if (sh_strtab) {
- IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
+ IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
}
}
- IF_DEBUG(linker,debugBelch( "\nString tables" ));
- strtab = NULL;
+ IF_DEBUG(linker,debugBelch( "\nString tables\n" ));
nstrtab = 0;
for (i = 0; i < ehdr->e_shnum; i++) {
if (shdr[i].sh_type == SHT_STRTAB
/* Ignore the section header's string table. */
&& i != ehdr->e_shstrndx
- /* Ignore string tables named .stabstr, as they contain
+ /* Ignore string tables named .stabstr, as they contain
debugging info. */
&& 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
) {
- IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
- strtab = ehdrC + shdr[i].sh_offset;
+ IF_DEBUG(linker,debugBelch(" section %d is a normal string table\n", i ));
nstrtab++;
}
}
- if (nstrtab != 1) {
- errorBelch("%s: no string tables, or too many", oc->fileName);
- return 0;
+ if (nstrtab == 0) {
+ IF_DEBUG(linker,debugBelch(" no normal string tables (potentially, but not necessarily a problem)\n"));
}
nsymtabs = 0;
- IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
+ IF_DEBUG(linker,debugBelch( "Symbol tables\n" ));
for (i = 0; i < ehdr->e_shnum; i++) {
if (shdr[i].sh_type != SHT_SYMTAB) continue;
IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
}
IF_DEBUG(linker,debugBelch(" " ));
- IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
+ IF_DEBUG(linker,debugBelch("name=%s\n",
+ ehdrC + shdr[shdr[i].sh_link].sh_offset
+ + stab[j].st_name ));
}
}
if (nsymtabs == 0) {
- errorBelch("%s: didn't find any symbol tables", oc->fileName);
- return 0;
+ // Not having a symbol table is not in principle a problem.
+ // When an object file has no symbols then the 'strip' program
+ // typically will remove the symbol table entirely.
+ IF_DEBUG(linker,debugBelch(" no symbol tables (potentially, but not necessarily a problem)\n"));
}
return 1;
*is_bss = FALSE;
if (hdr->sh_type == SHT_PROGBITS
- && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
- /* .text-style section */
- return SECTIONKIND_CODE_OR_RODATA;
+ && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
+ /* .text-style section */
+ return SECTIONKIND_CODE_OR_RODATA;
}
if (hdr->sh_type == SHT_PROGBITS
- && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
- /* .data-style section */
- return SECTIONKIND_RWDATA;
+ && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
+ /* .data-style section */
+ return SECTIONKIND_RWDATA;
}
if (hdr->sh_type == SHT_PROGBITS
- && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
- /* .rodata-style section */
- return SECTIONKIND_CODE_OR_RODATA;
+ && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
+ /* .rodata-style section */
+ return SECTIONKIND_CODE_OR_RODATA;
}
if (hdr->sh_type == SHT_NOBITS
- && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
- /* .bss-style section */
- *is_bss = TRUE;
- return SECTIONKIND_RWDATA;
+ && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
+ /* .bss-style section */
+ *is_bss = TRUE;
+ return SECTIONKIND_RWDATA;
}
return SECTIONKIND_OTHER;
char* ehdrC = (char*)(oc->image);
Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
- char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
+ char* strtab;
Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
ASSERT(symhash != NULL);
- if (!strtab) {
- errorBelch("%s: no strtab", oc->fileName);
- return 0;
- }
-
k = 0;
for (i = 0; i < ehdr->e_shnum; i++) {
/* Figure out what kind of section it is. Logic derived from
char* zspace = stgCallocBytes(1, shdr[i].sh_size,
"ocGetNames_ELF(BSS)");
shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
- /*
+ /*
debugBelch("BSS section at 0x%x, size %d\n",
zspace, shdr[i].sh_size);
- */
+ */
}
/* fill in the section info */
/* copy stuff into this module's object symbol table */
stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
+ strtab = ehdrC + shdr[shdr[i].sh_link].sh_offset;
nent = shdr[i].sh_size / sizeof(Elf_Sym);
oc->n_symbols = nent;
oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
"ocGetNames_ELF(oc->symbols)");
+ //TODO: we ignore local symbols anyway right? So we can use the
+ // shdr[i].sh_info to get the index of the first non-local symbol
+ // ie we should use j = shdr[i].sh_info
for (j = 0; j < nent; j++) {
char isLocal = FALSE; /* avoids uninit-var warning */
char* nm = strtab + stab[j].st_name;
int secno = stab[j].st_shndx;
- /* Figure out if we want to add it; if so, set ad to its
+ /* Figure out if we want to add it; if so, set ad to its
address. Otherwise leave ad == NULL. */
if (secno == SHN_COMMON) {
isLocal = FALSE;
ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
- /*
+ /*
debugBelch("COMMON symbol, size %d name %s\n",
stab[j].st_size, nm);
- */
- /* Pointless to do addProddableBlock() for this area,
+ */
+ /* Pointless to do addProddableBlock() for this area,
since the linker should never poke around in it. */
- }
+ }
else
if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
|| ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
)
/* and not an undefined symbol */
&& stab[j].st_shndx != SHN_UNDEF
- /* and not in a "special section" */
+ /* and not in a "special section" */
&& stab[j].st_shndx < SHN_LORESERVE
&&
- /* and it's a not a section or string table or anything silly */
+ /* and it's a not a section or string table or anything silly */
( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
)
) {
- /* Section 0 is the undefined section, hence > and not >=. */
+ /* Section 0 is the undefined section, hence > and not >=. */
ASSERT(secno > 0 && secno < ehdr->e_shnum);
- /*
+ /*
if (shdr[secno].sh_type == SHT_NOBITS) {
debugBelch(" BSS symbol, size %d off %d name %s\n",
stab[j].st_size, stab[j].st_value, nm);
} else {
#ifdef ELF_FUNCTION_DESC
/* dlsym() and the initialisation table both give us function
- * descriptors, so to be consistent we store function descriptors
- * in the symbol table */
+ * descriptors, so to be consistent we store function descriptors
+ * in the symbol table */
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;
}
if (ad != NULL) {
ASSERT(nm != NULL);
- oc->symbols[j] = nm;
+ oc->symbols[j] = nm;
/* Acquire! */
if (isLocal) {
/* Ignore entirely. */
relocations appear to be of this form. */
static int
do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
- Elf_Shdr* shdr, int shnum,
- Elf_Sym* stab, char* strtab )
+ Elf_Shdr* shdr, int shnum )
{
int j;
char *symbol;
Elf_Word* targ;
Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
+ Elf_Sym* stab;
+ char* strtab;
int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
int target_shndx = shdr[shnum].sh_info;
int symtab_shndx = shdr[shnum].sh_link;
+ int strtab_shndx = shdr[symtab_shndx].sh_link;
stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
+ strtab= (char*) (ehdrC + shdr[ strtab_shndx ].sh_offset);
targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
- IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
- target_shndx, symtab_shndx ));
+ IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d and strtab %d\n",
+ target_shndx, symtab_shndx, strtab_shndx ));
/* Skip sections that we're not interested in. */
{
int is_bss;
SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
if (kind == SECTIONKIND_OTHER) {
- IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
- return 1;
+ IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
+ return 1;
}
}
S = 0;
} else {
Elf_Sym sym = stab[ELF_R_SYM(info)];
- /* First see if it is a local symbol. */
+ /* First see if it is a local symbol. */
if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
/* Yes, so we can get the address directly from the ELF symbol
table. */
(ehdrC + shdr[ sym.st_shndx ].sh_offset
+ stab[ELF_R_SYM(info)].st_value);
- } else {
+ } else {
symbol = strtab + sym.st_name;
stablePtr = (StgStablePtr)lookupHashTable(stablehash, (StgWord)symbol);
if (NULL == stablePtr) {
S_tmp = stableVal;
S = (Elf_Addr)S_tmp;
}
- }
+ }
if (!S) {
errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
- return 0;
+ return 0;
}
IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
}
IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
- (void*)P, (void*)S, (void*)A ));
+ (void*)P, (void*)S, (void*)A ));
checkProddableBlock ( oc, pP );
value = S + A;
# endif
default:
errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n",
- oc->fileName, (lnat)ELF_R_TYPE(info));
+ oc->fileName, (lnat)ELF_R_TYPE(info));
return 0;
}
sparc-solaris relocations appear to be of this form. */
static int
do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
- Elf_Shdr* shdr, int shnum,
- Elf_Sym* stab, char* strtab )
+ Elf_Shdr* shdr, int shnum )
{
int j;
char *symbol = NULL;
Elf_Addr targ;
Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
+ Elf_Sym* stab;
+ char* strtab;
int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
int target_shndx = shdr[shnum].sh_info;
int symtab_shndx = shdr[shnum].sh_link;
+ int strtab_shndx = shdr[symtab_shndx].sh_link;
stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
+ strtab= (char*) (ehdrC + shdr[ strtab_shndx ].sh_offset);
targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
target_shndx, symtab_shndx ));
# 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
S = 0;
} else {
Elf_Sym sym = stab[ELF_R_SYM(info)];
- /* First see if it is a local symbol. */
+ /* First see if it is a local symbol. */
if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
/* Yes, so we can get the address directly from the ELF symbol
table. */
(ehdrC + shdr[ sym.st_shndx ].sh_offset
+ stab[ELF_R_SYM(info)].st_value);
#ifdef ELF_FUNCTION_DESC
- /* Make a function descriptor for this function */
+ /* Make a function descriptor for this function */
if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
S = allocateFunctionDesc(S + A);
- A = 0;
+ A = 0;
}
#endif
- } else {
+ } else {
/* No, so look up the name in our global table. */
symbol = strtab + sym.st_name;
S_tmp = lookupSymbol( symbol );
S = (Elf_Addr)S_tmp;
#ifdef ELF_FUNCTION_DESC
- /* If a function, already a function descriptor - we would
- have to copy it to add an offset. */
+ /* If a function, already a function descriptor - we would
+ have to copy it to add an offset. */
if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
#endif
- }
+ }
if (!S) {
- errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
- return 0;
+ errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
+ return 0;
}
IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
}
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;
case R_PPC_ADDR16_HI:
*(Elf32_Half*) P = value >> 16;
break;
-
+
case R_PPC_ADDR16_HA:
*(Elf32_Half*) P = (value + 0x8000) >> 16;
break;
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;
}
#if x86_64_HOST_ARCH
case R_X86_64_64:
- *(Elf64_Xword *)P = value;
- break;
+ *(Elf64_Xword *)P = value;
+ break;
case R_X86_64_PC32:
{
- StgInt64 off = value - P;
- if (off >= 0x7fffffffL || off < -0x80000000L) {
- barf("R_X86_64_PC32 relocation out of range: %s = %p",
- symbol, off);
- }
- *(Elf64_Word *)P = (Elf64_Word)off;
- break;
+#if defined(ALWAYS_PIC)
+ barf("R_X86_64_PC32 relocation, but ALWAYS_PIC.");
+#else
+ StgInt64 off = value - P;
+ if (off >= 0x7fffffffL || off < -0x80000000L) {
+#if X86_64_ELF_NONPIC_HACK
+ 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;
+#endif
+ 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);
- }
- *(Elf64_Word *)P = (Elf64_Word)value;
- break;
+#if defined(ALWAYS_PIC)
+ barf("R_X86_64_32 relocation, but ALWAYS_PIC.");
+#else
+ if (value >= 0x7fffffffL) {
+#if X86_64_ELF_NONPIC_HACK
+ StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
+ -> 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;
+#endif
+ 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);
- }
- *(Elf64_Sword *)P = (Elf64_Sword)value;
- break;
+#if defined(ALWAYS_PIC)
+ barf("R_X86_64_32S relocation, but ALWAYS_PIC.");
+#else
+ if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
+#if X86_64_ELF_NONPIC_HACK
+ StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
+ -> 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;
+#endif
+ 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:
+ {
+#if defined(ALWAYS_PIC)
+ barf("R_X86_64_PLT32 relocation, but ALWAYS_PIC.");
+#else
+ StgInt64 off = value - P;
+ if (off >= 0x7fffffffL || off < -0x80000000L) {
+ StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
+ -> jumpIsland;
+ off = pltAddress + A - P;
+ }
+ *(Elf64_Word *)P = (Elf64_Word)off;
+#endif
+ break;
+ }
#endif
default:
errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n",
- oc->fileName, (lnat)ELF_R_TYPE(info));
+ oc->fileName, (lnat)ELF_R_TYPE(info));
return 0;
}
static int
ocResolve_ELF ( ObjectCode* oc )
{
- char *strtab;
int shnum, ok;
- Elf_Sym* stab = NULL;
char* ehdrC = (char*)(oc->image);
Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
- /* first find "the" symbol table */
- stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
-
- /* also go find the string table */
- strtab = findElfSection ( ehdrC, SHT_STRTAB );
-
- if (stab == NULL || strtab == NULL) {
- errorBelch("%s: can't find string or symbol table", oc->fileName);
- return 0;
- }
-
/* Process the relocation sections. */
for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
if (shdr[shnum].sh_type == SHT_REL) {
- ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
- shnum, stab, strtab );
+ ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr, shnum );
if (!ok) return ok;
}
else
if (shdr[shnum].sh_type == SHT_RELA) {
- ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
- shnum, stab, strtab );
+ ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr, shnum );
if (!ok) return ok;
}
}
- /* 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
}
/*
- * 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;
if( i == ehdr->e_shnum )
{
- errorBelch( "This ELF file contains no symtab" );
- return 0;
+ // Not having a symbol table is not in principle a problem.
+ // When an object file has no symbols then the 'strip' program
+ // typically will remove the symbol table entirely.
+ IF_DEBUG(linker, debugBelch( "The ELF file %s contains no symtab\n",
+ oc->archiveMemberName ? oc->archiveMemberName : oc->fileName ));
+ return 1;
}
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 */
*) 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);
unsigned i;
- for( i = 0; i < header->ncmds; i++ )
- {
- if( lc->cmd == LC_SYMTAB )
- {
+ IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: start\n"));
+
+ for (i = 0; i < header->ncmds; i++) {
+ if (lc->cmd == LC_SYMTAB) {
+
// Find out the first and last undefined external
// symbol, so we don't have to allocate too many
- // jump islands.
+ // jump islands/GOT entries.
+
struct symtab_command *symLC = (struct symtab_command *) lc;
unsigned min = symLC->nsyms, max = 0;
struct nlist *nlist =
symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
: NULL;
- for(i=0;i<symLC->nsyms;i++)
- {
- if(nlist[i].n_type & N_STAB)
+
+ for (i = 0; i < symLC->nsyms; i++) {
+
+ if (nlist[i].n_type & N_STAB) {
;
- else if(nlist[i].n_type & N_EXT)
- {
+ } else if (nlist[i].n_type & N_EXT) {
+
if((nlist[i].n_type & N_TYPE) == N_UNDF
- && (nlist[i].n_value == 0))
- {
- if(i < min)
+ && (nlist[i].n_value == 0)) {
+
+ if (i < min) {
min = i;
- if(i > max)
+ }
+
+ if (i > max) {
max = i;
}
}
}
- if(max >= min)
- return ocAllocateJumpIslands(oc, max - min + 1, min);
+ }
+
+ if (max >= 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;
+
+ IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: start\n"));
+
+ for (i = 0; i < header->ncmds; i++) {
+ if (lc->cmd == LC_SYMTAB) {
-static int ocVerifyImage_MachO(ObjectCode* oc STG_UNUSED)
+ // Just allocate one entry for every symbol
+ struct symtab_command *symLC = (struct symtab_command *) lc;
+
+ IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: allocate %d symbols\n", symLC->nsyms));
+ IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: done\n"));
+ return ocAllocateSymbolExtras(oc, symLC->nsyms, 0);
+ }
+
+ lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
+ }
+
+ IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: allocated no symbols\n"));
+ IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: done\n"));
+ 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_DEBUG(linker, debugBelch("ocVerifyImage_MachO: start\n"));
+
+#if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
+ if(header->magic != MH_MAGIC_64) {
+ errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
+ oc->fileName, MH_MAGIC_64, header->magic);
+ return 0;
+ }
+#else
+ if(header->magic != MH_MAGIC) {
+ errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
+ oc->fileName, MH_MAGIC, header->magic);
+ return 0;
+ }
+#endif
+
+ // FIXME: do some more verifying here
+ IF_DEBUG(linker, debugBelch("ocVerifyImage_MachO: done\n"));
return 1;
}
-static int resolveImports(
+static int
+resolveImports(
ObjectCode* oc,
char *image,
struct symtab_command *symLC,
unsigned i;
size_t itemSize = 4;
+ IF_DEBUG(linker, debugBelch("resolveImports: start\n"));
+
#if i386_HOST_ARCH
int isJumpTable = 0;
- if(!strcmp(sect->sectname,"__jump_table"))
- {
+
+ if (strcmp(sect->sectname,"__jump_table") == 0) {
isJumpTable = 1;
itemSize = 5;
ASSERT(sect->reserved2 == itemSize);
}
+
#endif
for(i=0; i*itemSize < sect->size;i++)
{
- // according to otool, reserved1 contains the first index into the indirect symbol table
- struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
- char *nm = image + symLC->stroff + symbol->n_un.n_strx;
- void *addr = NULL;
-
- if((symbol->n_type & N_TYPE) == N_UNDF
- && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
- addr = (void*) (symbol->n_value);
- else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
- ;
- else
- addr = lookupSymbol(nm);
- if(!addr)
- {
- errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
- return 0;
- }
- ASSERT(addr);
+ // according to otool, reserved1 contains the first index into the indirect symbol table
+ struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
+ char *nm = image + symLC->stroff + symbol->n_un.n_strx;
+ void *addr = NULL;
+
+ IF_DEBUG(linker, debugBelch("resolveImports: resolving %s\n", nm));
+
+ if ((symbol->n_type & N_TYPE) == N_UNDF
+ && (symbol->n_type & N_EXT) && (symbol->n_value != 0)) {
+ addr = (void*) (symbol->n_value);
+ IF_DEBUG(linker, debugBelch("resolveImports: undefined external %s has value %p\n", nm, addr));
+ } else {
+ addr = lookupSymbol(nm);
+ IF_DEBUG(linker, debugBelch("resolveImports: looking up %s, %p\n", nm, addr));
+ }
+ if (!addr)
+ {
+ errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
+ return 0;
+ }
+ ASSERT(addr);
#if i386_HOST_ARCH
- if(isJumpTable)
- {
+ if (isJumpTable) {
checkProddableBlock(oc,image + sect->offset + i*itemSize);
- *(image + sect->offset + i*itemSize) = 0xe9; // jmp
+
+ *(image + sect->offset + i * itemSize) = 0xe9; // jmp opcode
*(unsigned*)(image + sect->offset + i*itemSize + 1)
= (char*)addr - (image + sect->offset + i*itemSize + 5);
}
else
#endif
- {
- checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
- ((void**)(image + sect->offset))[i] = addr;
+ {
+ checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
+ ((void**)(image + sect->offset))[i] = addr;
}
}
+ IF_DEBUG(linker, debugBelch("resolveImports: done\n"));
return 1;
}
unsigned long address)
{
int i;
- for(i = 0; i < nSections; i++)
+ IF_DEBUG(linker, debugBelch("relocateAddress: start\n"));
+ for (i = 0; i < nSections; i++)
{
- if(sections[i].addr <= address
+ IF_DEBUG(linker, debugBelch(" relocating address in section %d\n", i));
+ if (sections[i].addr <= address
&& address < sections[i].addr + sections[i].size)
{
return (unsigned long)oc->image
int nSections, struct section* sections, struct section *sect)
{
struct relocation_info *relocs;
- int i,n;
+ int i, n;
+
+ IF_DEBUG(linker, debugBelch("relocateSection: start\n"));
if(!strcmp(sect->sectname,"__la_symbol_ptr"))
- return 1;
+ return 1;
else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
- return 1;
+ return 1;
else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
- return 1;
+ return 1;
else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
- return 1;
+ return 1;
n = sect->nreloc;
+ IF_DEBUG(linker, debugBelch("relocateSection: number of relocations: %d\n", n));
+
relocs = (struct relocation_info*) (image + sect->reloff);
for(i=0;i<n;i++)
{
- if(relocs[i].r_address & R_SCATTERED)
- {
- struct scattered_relocation_info *scat =
- (struct scattered_relocation_info*) &relocs[i];
-
- if(!scat->r_pcrel)
- {
- if(scat->r_length == 2)
- {
- unsigned long word = 0;
- unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
- checkProddableBlock(oc,wordPtr);
+#ifdef x86_64_HOST_ARCH
+ struct relocation_info *reloc = &relocs[i];
+
+ char *thingPtr = image + sect->offset + 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_DEBUG(linker,
+ debugBelch("relocateSection: length = %d, thing = %" PRId64 ", baseValue = %p\n",
+ reloc->r_length, thing, (char *)baseValue));
+
+ if (type == X86_64_RELOC_GOT
+ || type == X86_64_RELOC_GOT_LOAD)
+ {
+ struct nlist *symbol = &nlist[reloc->r_symbolnum];
+ char *nm = image + symLC->stroff + symbol->n_un.n_strx;
+
+ IF_DEBUG(linker, debugBelch("relocateSection: making jump island for %s, extern = %d, X86_64_RELOC_GOT\n", nm, reloc->r_extern));
+ ASSERT(reloc->r_extern);
+ value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, (unsigned long)lookupSymbol(nm))->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_DEBUG(linker, debugBelch("relocateSection: looking up external symbol %s\n", nm));
+ IF_DEBUG(linker, debugBelch(" : type = %d\n", symbol->n_type));
+ IF_DEBUG(linker, debugBelch(" : sect = %d\n", symbol->n_sect));
+ IF_DEBUG(linker, debugBelch(" : desc = %d\n", symbol->n_desc));
+ IF_DEBUG(linker, debugBelch(" : value = %p\n", (void *)symbol->n_value));
+ if ((symbol->n_type & N_TYPE) == N_SECT) {
+ value = relocateAddress(oc, nSections, sections,
+ symbol->n_value);
+ IF_DEBUG(linker, debugBelch("relocateSection, defined external symbol %s, relocated address %p\n", nm, (void *)value));
+ }
+ else {
+ value = (uint64_t) lookupSymbol(nm);
+ IF_DEBUG(linker, debugBelch("relocateSection: external symbol %s, address %p\n", nm, (void *)value));
+ }
+ }
+ else
+ {
+ // If the relocation is not through the global offset table
+ // or external, then set the value to the baseValue. This
+ // will leave displacements into the __const section
+ // unchanged (as they ought to be).
+
+ value = baseValue;
+ }
+
+ IF_DEBUG(linker, debugBelch("relocateSection: value = %p\n", (void *)value));
+
+ 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:
+ case X86_64_RELOC_SIGNED_1:
+ case X86_64_RELOC_SIGNED_2:
+ case X86_64_RELOC_SIGNED_4:
+ ASSERT(reloc->r_pcrel);
+ thing += value - baseValue;
+ break;
+ 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 =
+ (struct scattered_relocation_info*) &relocs[i];
+
+ if(!scat->r_pcrel)
+ {
+ if(scat->r_length == 2)
+ {
+ unsigned long word = 0;
+ unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
+ checkProddableBlock(oc,wordPtr);
// Note on relocation types:
// i386 uses the GENERIC_RELOC_* types,
// Therefore, we use GENERIC_RELOC_VANILLA
// and GENERIC_RELOC_PAIR instead of the PPC variants,
// and use #ifdefs for the other types.
-
- // Step 1: Figure out what the relocated value should be
- if(scat->r_type == GENERIC_RELOC_VANILLA)
- {
- word = *wordPtr + (unsigned long) relocateAddress(
- oc,
+
+ // Step 1: Figure out what the relocated value should be
+ if (scat->r_type == GENERIC_RELOC_VANILLA) {
+ word = *wordPtr
+ + (unsigned long) relocateAddress(oc,
nSections,
sections,
scat->r_value)
- scat->r_value;
- }
+ }
#ifdef powerpc_HOST_ARCH
- else if(scat->r_type == PPC_RELOC_SECTDIFF
- || scat->r_type == PPC_RELOC_LO16_SECTDIFF
- || scat->r_type == PPC_RELOC_HI16_SECTDIFF
- || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
+ else if(scat->r_type == PPC_RELOC_SECTDIFF
+ || scat->r_type == PPC_RELOC_LO16_SECTDIFF
+ || scat->r_type == PPC_RELOC_HI16_SECTDIFF
+ || scat->r_type == PPC_RELOC_HA16_SECTDIFF
+ || scat->r_type == PPC_RELOC_LOCAL_SECTDIFF)
#else
- else if(scat->r_type == GENERIC_RELOC_SECTDIFF)
+ else if(scat->r_type == GENERIC_RELOC_SECTDIFF
+ || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
#endif
- {
- struct scattered_relocation_info *pair =
- (struct scattered_relocation_info*) &relocs[i+1];
+ {
+ struct scattered_relocation_info *pair =
+ (struct scattered_relocation_info*) &relocs[i+1];
- if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR)
- barf("Invalid Mach-O file: "
- "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
+ if (!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR) {
+ barf("Invalid Mach-O file: "
+ "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
+ }
- word = (unsigned long)
- (relocateAddress(oc, nSections, sections, scat->r_value)
- - relocateAddress(oc, nSections, sections, pair->r_value));
- i++;
- }
+ word = (unsigned long)
+ (relocateAddress(oc, nSections, sections, scat->r_value)
+ - relocateAddress(oc, nSections, sections, pair->r_value));
+ i++;
+ }
#ifdef powerpc_HOST_ARCH
- else if(scat->r_type == PPC_RELOC_HI16
+ else if(scat->r_type == PPC_RELOC_HI16
|| scat->r_type == PPC_RELOC_LO16
|| scat->r_type == PPC_RELOC_HA16
|| scat->r_type == PPC_RELOC_LO14)
{ // these are generated by label+offset things
- struct relocation_info *pair = &relocs[i+1];
- if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
- barf("Invalid Mach-O file: "
- "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
-
+ struct relocation_info *pair = &relocs[i+1];
+
+ if ((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR) {
+ barf("Invalid Mach-O file: "
+ "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
+ }
+
if(scat->r_type == PPC_RELOC_LO16)
{
word = ((unsigned short*) wordPtr)[1];
word = ((unsigned short*) wordPtr)[1] << 16;
word += ((short)relocs[i+1].r_address & (short)0xFFFF);
}
-
-
+
+
word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
- scat->r_value;
-
+
i++;
}
#endif
- else
- continue; // ignore the others
+ else {
+ barf ("Don't know how to handle this Mach-O "
+ "scattered relocation entry: "
+ "object file %s; entry type %ld; "
+ "address %#lx\n",
+ OC_INFORMATIVE_FILENAME(oc),
+ scat->r_type,
+ scat->r_address);
+ return 0;
+ }
#ifdef powerpc_HOST_ARCH
if(scat->r_type == GENERIC_RELOC_VANILLA
|| scat->r_type == PPC_RELOC_SECTDIFF)
#else
if(scat->r_type == GENERIC_RELOC_VANILLA
- || scat->r_type == GENERIC_RELOC_SECTDIFF)
+ || scat->r_type == GENERIC_RELOC_SECTDIFF
+ || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
#endif
{
*wordPtr = word;
}
#ifdef powerpc_HOST_ARCH
- else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
+ else if (scat->r_type == PPC_RELOC_LO16_SECTDIFF
+ || scat->r_type == PPC_RELOC_LO16)
{
((unsigned short*) wordPtr)[1] = word & 0xFFFF;
}
- else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
+ else if (scat->r_type == PPC_RELOC_HI16_SECTDIFF
+ || scat->r_type == PPC_RELOC_HI16)
{
((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
}
- else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
+ else if (scat->r_type == PPC_RELOC_HA16_SECTDIFF
+ || scat->r_type == PPC_RELOC_HA16)
{
((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
+ ((word & (1<<15)) ? 1 : 0);
}
#endif
- }
- }
+ }
+ else
+ {
+ barf("Can't handle Mach-O scattered relocation entry "
+ "with this r_length tag: "
+ "object file %s; entry type %ld; "
+ "r_length tag %ld; address %#lx\n",
+ OC_INFORMATIVE_FILENAME(oc),
+ scat->r_type,
+ scat->r_length,
+ scat->r_address);
+ return 0;
+ }
+ }
+ else /* scat->r_pcrel */
+ {
+ barf("Don't know how to handle *PC-relative* Mach-O "
+ "scattered relocation entry: "
+ "object file %s; entry type %ld; address %#lx\n",
+ OC_INFORMATIVE_FILENAME(oc),
+ scat->r_type,
+ scat->r_address);
+ return 0;
+ }
- continue; // FIXME: I hope it's OK to ignore all the others.
- }
- else
- {
- struct relocation_info *reloc = &relocs[i];
- if(reloc->r_pcrel && !reloc->r_extern)
- continue;
+ }
+ else /* !(relocs[i].r_address & R_SCATTERED) */
+ {
+ struct relocation_info *reloc = &relocs[i];
+ if (reloc->r_pcrel && !reloc->r_extern) {
+ IF_DEBUG(linker, debugBelch("relocateSection: pc relative but not external, skipping\n"));
+ continue;
+ }
- if(reloc->r_length == 2)
- {
- unsigned long word = 0;
+ if (reloc->r_length == 2) {
+ unsigned long word = 0;
#ifdef powerpc_HOST_ARCH
unsigned long jumpIsland = 0;
long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
// bugs.
#endif
- unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
- checkProddableBlock(oc,wordPtr);
+ unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
+ checkProddableBlock(oc,wordPtr);
- if(reloc->r_type == GENERIC_RELOC_VANILLA)
- {
- word = *wordPtr;
- }
+ if (reloc->r_type == GENERIC_RELOC_VANILLA) {
+ word = *wordPtr;
+ }
#ifdef powerpc_HOST_ARCH
- else if(reloc->r_type == PPC_RELOC_LO16)
- {
- word = ((unsigned short*) wordPtr)[1];
- word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
- }
- else if(reloc->r_type == PPC_RELOC_HI16)
- {
- word = ((unsigned short*) wordPtr)[1] << 16;
- word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
- }
- else if(reloc->r_type == PPC_RELOC_HA16)
- {
- word = ((unsigned short*) wordPtr)[1] << 16;
- word += ((short)relocs[i+1].r_address & (short)0xFFFF);
- }
- else if(reloc->r_type == PPC_RELOC_BR24)
- {
- word = *wordPtr;
- word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
- }
-#endif
-
- if(!reloc->r_extern)
- {
- long delta =
- sections[reloc->r_symbolnum-1].offset
- - sections[reloc->r_symbolnum-1].addr
- + ((long) image);
-
- word += delta;
- }
- else
- {
- struct nlist *symbol = &nlist[reloc->r_symbolnum];
- char *nm = image + symLC->stroff + symbol->n_un.n_strx;
- void *symbolAddress = lookupSymbol(nm);
- if(!symbolAddress)
- {
- errorBelch("\nunknown symbol `%s'", nm);
- return 0;
- }
-
- if(reloc->r_pcrel)
- {
+ else if (reloc->r_type == PPC_RELOC_LO16) {
+ word = ((unsigned short*) wordPtr)[1];
+ word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
+ }
+ else if (reloc->r_type == PPC_RELOC_HI16) {
+ word = ((unsigned short*) wordPtr)[1] << 16;
+ word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
+ }
+ else if (reloc->r_type == PPC_RELOC_HA16) {
+ word = ((unsigned short*) wordPtr)[1] << 16;
+ word += ((short)relocs[i+1].r_address & (short)0xFFFF);
+ }
+ else if (reloc->r_type == PPC_RELOC_BR24) {
+ word = *wordPtr;
+ word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
+ }
+#endif
+ else {
+ barf("Can't handle this Mach-O relocation entry "
+ "(not scattered): "
+ "object file %s; entry type %ld; address %#lx\n",
+ OC_INFORMATIVE_FILENAME(oc),
+ reloc->r_type,
+ reloc->r_address);
+ return 0;
+ }
+
+ if (!reloc->r_extern) {
+ long delta = sections[reloc->r_symbolnum-1].offset
+ - sections[reloc->r_symbolnum-1].addr
+ + ((long) image);
+
+ word += delta;
+ }
+ else {
+ struct nlist *symbol = &nlist[reloc->r_symbolnum];
+ char *nm = image + symLC->stroff + symbol->n_un.n_strx;
+ void *symbolAddress = lookupSymbol(nm);
+
+ if (!symbolAddress) {
+ errorBelch("\nunknown symbol `%s'", nm);
+ return 0;
+ }
+
+ if (reloc->r_pcrel) {
#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);
- if(jumpIsland != 0)
- {
+ ASSERT(word + reloc->r_address == 0);
+ jumpIsland = (unsigned long)
+ &makeSymbolExtra(oc,
+ reloc->r_symbolnum,
+ (unsigned long) symbolAddress)
+ -> jumpIsland;
+ if (jumpIsland != 0) {
offsetToJumpIsland = word + jumpIsland
- (((long)image) + sect->offset - sect->addr);
}
#endif
- word += (unsigned long) symbolAddress
+ word += (unsigned long) symbolAddress
- (((long)image) + sect->offset - sect->addr);
}
- else
- {
+ else {
word += (unsigned long) symbolAddress;
}
- }
+ }
- if(reloc->r_type == GENERIC_RELOC_VANILLA)
- {
- *wordPtr = word;
- continue;
- }
+ if (reloc->r_type == GENERIC_RELOC_VANILLA) {
+ *wordPtr = word;
+ continue;
+ }
#ifdef powerpc_HOST_ARCH
- else if(reloc->r_type == PPC_RELOC_LO16)
- {
- ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
- i++; continue;
- }
- else if(reloc->r_type == PPC_RELOC_HI16)
- {
- ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
- i++; continue;
- }
- else if(reloc->r_type == PPC_RELOC_HA16)
- {
- ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
- + ((word & (1<<15)) ? 1 : 0);
- i++; continue;
- }
- else if(reloc->r_type == PPC_RELOC_BR24)
- {
- if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
- {
+ else if(reloc->r_type == PPC_RELOC_LO16)
+ {
+ ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
+ i++;
+ continue;
+ }
+ else if(reloc->r_type == PPC_RELOC_HI16)
+ {
+ ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
+ i++;
+ continue;
+ }
+ else if(reloc->r_type == PPC_RELOC_HA16)
+ {
+ ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
+ + ((word & (1<<15)) ? 1 : 0);
+ i++;
+ continue;
+ }
+ else if(reloc->r_type == PPC_RELOC_BR24)
+ {
+ if ((word & 0x03) != 0) {
+ barf("%s: unconditional relative branch with a displacement "
+ "which isn't a multiple of 4 bytes: %#lx",
+ OC_INFORMATIVE_FILENAME(oc),
+ word);
+ }
+
+ if((word & 0xFE000000) != 0xFE000000 &&
+ (word & 0xFE000000) != 0x00000000) {
// The branch offset is too large.
// Therefore, we try to use a jump island.
- if(jumpIsland == 0)
- {
- barf("unconditional relative branch out of range: "
- "no jump island available");
+ if (jumpIsland == 0) {
+ barf("%s: unconditional relative branch out of range: "
+ "no jump island available: %#lx",
+ OC_INFORMATIVE_FILENAME(oc),
+ word);
}
-
+
word = offsetToJumpIsland;
- if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
- barf("unconditional relative branch out of range: "
- "jump island out of range");
+
+ if((word & 0xFE000000) != 0xFE000000 &&
+ (word & 0xFE000000) != 0x00000000) {
+ barf("%s: unconditional relative branch out of range: "
+ "jump island out of range: %#lx",
+ OC_INFORMATIVE_FILENAME(oc),
+ word);
+ }
}
- *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
- continue;
- }
+ *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
+ continue;
+ }
#endif
}
- barf("\nunknown relocation %d",reloc->r_type);
- return 0;
- }
+ else
+ {
+ barf("Can't handle Mach-O relocation entry (not scattered) "
+ "with this r_length tag: "
+ "object file %s; entry type %ld; "
+ "r_length tag %ld; address %#lx\n",
+ OC_INFORMATIVE_FILENAME(oc),
+ reloc->r_type,
+ reloc->r_length,
+ reloc->r_address);
+ return 0;
+ }
+ }
+#endif
}
+
+ IF_DEBUG(linker, debugBelch("relocateSection: done\n"));
return 1;
}
-static int ocGetNames_MachO(ObjectCode* oc)
+static int
+ocGetNames_MachO(ObjectCode* oc)
{
char *image = (char*) oc->image;
struct mach_header *header = (struct mach_header*) image;
char *commonStorage = NULL;
unsigned long commonCounter;
+ IF_DEBUG(linker,debugBelch("ocGetNames_MachO: start\n"));
+
for(i=0;i<header->ncmds;i++)
{
- if(lc->cmd == LC_SEGMENT)
- segLC = (struct segment_command*) lc;
- else if(lc->cmd == LC_SYMTAB)
- symLC = (struct symtab_command*) lc;
- lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
+ 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;
+ }
+
+ lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
}
sections = (struct section*) (segLC+1);
nlist = symLC ? (struct nlist*) (image + symLC->symoff)
: NULL;
+ if (!segLC) {
+ barf("ocGetNames_MachO: no segment load command");
+ }
+
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: will load %d sections\n", segLC->nsects));
for(i=0;i<segLC->nsects;i++)
{
- if(sections[i].size == 0)
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: section %d\n", i));
+
+ if (sections[i].size == 0) {
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: found a zero length section, skipping\n"));
continue;
+ }
if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
{
sections[i].offset = zeroFillArea - image;
}
- if(!strcmp(sections[i].sectname,"__text"))
- addSection(oc, SECTIONKIND_CODE_OR_RODATA,
- (void*) (image + sections[i].offset),
- (void*) (image + sections[i].offset + sections[i].size));
- else if(!strcmp(sections[i].sectname,"__const"))
- addSection(oc, SECTIONKIND_RWDATA,
- (void*) (image + sections[i].offset),
- (void*) (image + sections[i].offset + sections[i].size));
- else if(!strcmp(sections[i].sectname,"__data"))
- addSection(oc, SECTIONKIND_RWDATA,
- (void*) (image + sections[i].offset),
- (void*) (image + sections[i].offset + sections[i].size));
- else if(!strcmp(sections[i].sectname,"__bss")
- || !strcmp(sections[i].sectname,"__common"))
- addSection(oc, SECTIONKIND_RWDATA,
- (void*) (image + sections[i].offset),
- (void*) (image + sections[i].offset + sections[i].size));
-
- addProddableBlock(oc, (void*) (image + sections[i].offset),
+ if (!strcmp(sections[i].sectname,"__text")) {
+
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: adding __text section\n"));
+ addSection(oc, SECTIONKIND_CODE_OR_RODATA,
+ (void*) (image + sections[i].offset),
+ (void*) (image + sections[i].offset + sections[i].size));
+ }
+ else if (!strcmp(sections[i].sectname,"__const")) {
+
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: adding __const section\n"));
+ addSection(oc, SECTIONKIND_RWDATA,
+ (void*) (image + sections[i].offset),
+ (void*) (image + sections[i].offset + sections[i].size));
+ }
+ else if (!strcmp(sections[i].sectname,"__data")) {
+
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: adding __data section\n"));
+ addSection(oc, SECTIONKIND_RWDATA,
+ (void*) (image + sections[i].offset),
+ (void*) (image + sections[i].offset + sections[i].size));
+ }
+ else if(!strcmp(sections[i].sectname,"__bss")
+ || !strcmp(sections[i].sectname,"__common")) {
+
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: adding __bss section\n"));
+ addSection(oc, SECTIONKIND_RWDATA,
+ (void*) (image + sections[i].offset),
+ (void*) (image + sections[i].offset + sections[i].size));
+ }
+ addProddableBlock(oc,
+ (void *) (image + sections[i].offset),
sections[i].size);
}
- // count external symbols defined here
+ // count external symbols defined here
oc->n_symbols = 0;
- if(symLC)
- {
- for(i=0;i<symLC->nsyms;i++)
- {
- if(nlist[i].n_type & N_STAB)
+ if (symLC) {
+ for (i = 0; i < symLC->nsyms; i++) {
+ if (nlist[i].n_type & N_STAB) {
;
+ }
else if(nlist[i].n_type & N_EXT)
{
if((nlist[i].n_type & N_TYPE) == N_UNDF
}
}
}
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: %d external symbols\n", oc->n_symbols));
oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
- "ocGetNames_MachO(oc->symbols)");
+ "ocGetNames_MachO(oc->symbols)");
if(symLC)
{
if(nlist[i].n_type & N_EXT)
{
char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
- if((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm))
- ; // weak definition, and we already have a definition
+ if ((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm)) {
+ // weak definition, and we already have a definition
+ IF_DEBUG(linker, debugBelch(" weak: %s\n", nm));
+ }
else
{
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting %s\n", nm));
ghciInsertStrHashTable(oc->fileName, symhash, nm,
image
+ sections[nlist[i].n_sect-1].offset
oc->symbols[curSymbol++] = nm;
}
}
+ else
+ {
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: \t...not external, skipping\n"));
+ }
+ }
+ else
+ {
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: \t...not defined in this section, skipping\n"));
}
}
}
commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
commonCounter = (unsigned long)commonStorage;
- if(symLC)
- {
- for(i=0;i<symLC->nsyms;i++)
- {
- if((nlist[i].n_type & N_TYPE) == N_UNDF
- && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
- {
- char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
- unsigned long sz = nlist[i].n_value;
- nlist[i].n_value = commonCounter;
+ if (symLC) {
+ for (i = 0; i < symLC->nsyms; i++) {
+ if((nlist[i].n_type & N_TYPE) == N_UNDF
+ && (nlist[i].n_type & N_EXT)
+ && (nlist[i].n_value != 0)) {
+
+ char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
+ unsigned long sz = nlist[i].n_value;
+
+ nlist[i].n_value = commonCounter;
- ghciInsertStrHashTable(oc->fileName, symhash, nm,
- (void*)commonCounter);
- oc->symbols[curSymbol++] = nm;
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting common symbol: %s\n", nm));
+ ghciInsertStrHashTable(oc->fileName, symhash, nm,
+ (void*)commonCounter);
+ oc->symbols[curSymbol++] = nm;
- commonCounter += sz;
- }
+ commonCounter += sz;
+ }
}
}
+
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: done\n"));
return 1;
}
-static int ocResolve_MachO(ObjectCode* oc)
+static int
+ocResolve_MachO(ObjectCode* oc)
{
char *image = (char*) oc->image;
struct mach_header *header = (struct mach_header*) image;
struct dysymtab_command *dsymLC = NULL;
struct nlist *nlist;
- for(i=0;i<header->ncmds;i++)
+ IF_DEBUG(linker, debugBelch("ocResolve_MachO: start\n"));
+ for (i = 0; i < header->ncmds; i++)
{
- if(lc->cmd == LC_SEGMENT)
- segLC = (struct segment_command*) lc;
- else if(lc->cmd == LC_SYMTAB)
- symLC = (struct symtab_command*) lc;
- else if(lc->cmd == LC_DYSYMTAB)
- dsymLC = (struct dysymtab_command*) lc;
- lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
+ if (lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64) {
+ segLC = (struct segment_command*) lc;
+ IF_DEBUG(linker, debugBelch("ocResolve_MachO: found a 32 or 64 bit segment load command\n"));
+ }
+ else if (lc->cmd == LC_SYMTAB) {
+ symLC = (struct symtab_command*) lc;
+ IF_DEBUG(linker, debugBelch("ocResolve_MachO: found a symbol table load command\n"));
+ }
+ else if (lc->cmd == LC_DYSYMTAB) {
+ dsymLC = (struct dysymtab_command*) lc;
+ IF_DEBUG(linker, debugBelch("ocResolve_MachO: found a dynamic symbol table load command\n"));
+ }
+
+ lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
}
sections = (struct section*) (segLC+1);
unsigned long *indirectSyms
= (unsigned long*) (image + dsymLC->indirectsymoff);
- for(i=0;i<segLC->nsects;i++)
+ IF_DEBUG(linker, debugBelch("ocResolve_MachO: resolving dsymLC\n"));
+ for (i = 0; i < segLC->nsects; i++)
{
if( !strcmp(sections[i].sectname,"__la_symbol_ptr")
|| !strcmp(sections[i].sectname,"__la_sym_ptr2")
if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
return 0;
}
+ else
+ {
+ IF_DEBUG(linker, debugBelch("ocResolve_MachO: unknown section\n"));
+ }
}
}
-
+
for(i=0;i<segLC->nsects;i++)
{
- if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
- return 0;
- }
+ IF_DEBUG(linker, debugBelch("ocResolve_MachO: relocating section %d\n", i));
- /* Free the local symbol table; we won't need it again. */
- freeHashTable(oc->lochash, NULL);
- oc->lochash = NULL;
+ if (!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
+ return 0;
+ }
#if defined (powerpc_HOST_ARCH)
ocFlushInstructionCache( oc );
* Yuck.
*/
-static void machoInitSymbolsWithoutUnderscore()
+extern void* symbolsWithoutUnderscore[];
+
+static void
+machoInitSymbolsWithoutUnderscore(void)
{
- extern void* symbolsWithoutUnderscore[];
void **p = symbolsWithoutUnderscore;
__asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
-#undef Sym
-#define Sym(x) \
+#undef SymI_NeedsProto
+#define SymI_NeedsProto(x) \
__asm__ volatile(".long " # x);
RTS_MACHO_NOUNDERLINE_SYMBOLS
__asm__ volatile(".text");
-
-#undef Sym
-#define Sym(x) \
+
+#undef SymI_NeedsProto
+#define SymI_NeedsProto(x) \
ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
-
+
RTS_MACHO_NOUNDERLINE_SYMBOLS
-
-#undef Sym
+
+#undef SymI_NeedsProto
}
#endif
+#ifndef USE_MMAP
/*
* Figure out by how much to shift the entire Mach-O file in memory
* when loading so that its single segment ends up 16-byte-aligned
*/
-static int machoGetMisalignment( FILE * f )
+static int
+machoGetMisalignment( FILE * f )
{
struct mach_header header;
int misalignment;
-
- fread(&header, sizeof(header), 1, f);
- rewind(f);
- if(header.magic != MH_MAGIC)
- return 0;
-
+ {
+ int n = fread(&header, sizeof(header), 1, f);
+ if (n != 1) {
+ barf("machoGetMisalignment: can't read the Mach-O header");
+ }
+ }
+ fseek(f, -sizeof(header), SEEK_CUR);
+
+#if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
+ if(header.magic != MH_MAGIC_64) {
+ barf("Bad magic. Expected: %08x, got: %08x.",
+ MH_MAGIC_64, header.magic);
+ }
+#else
+ if(header.magic != MH_MAGIC) {
+ barf("Bad magic. Expected: %08x, got: %08x.",
+ MH_MAGIC, header.magic);
+ }
+#endif
+
misalignment = (header.sizeofcmds + sizeof(header))
& 0xF;
return misalignment ? (16 - misalignment) : 0;
}
-
#endif
+#endif
projects / ghc-hetmet.git / blobdiff