#include "PosixSource.h"
#endif
-/* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and
+/* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and
MREMAP_MAYMOVE from <sys/mman.h>.
*/
#ifdef __linux__
# 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
/* Hash table mapping symbol names to Symbol */
static /*Str*/HashTable *symhash;
-typedef struct {
- void *addr;
-} rootEntry;
-
/* Hash table mapping symbol names to StgStablePtr */
static /*Str*/HashTable *stablehash;
-rootEntry *root_ptr_table = NULL;
-static rootEntry *root_ptr_free = NULL;
-
-static unsigned int RPT_size = 0;
/* List of currently loaded objects */
ObjectCode *objects = NULL; /* initially empty */
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 ocResolve_MachO ( ObjectCode* oc );
static int machoGetMisalignment( FILE * );
+#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
+static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
+#endif
#ifdef powerpc_HOST_ARCH
-static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
static void machoInitSymbolsWithoutUnderscore( void );
#endif
#endif
-#if defined(x86_64_HOST_ARCH)
-static void*x86_64_high_symbol( char *lbl, void *addr );
-#endif
+/* on x86_64 we have a problem with relocating symbol references in
+ * code that was compiled without -fPIC. By default, the small memory
+ * model is used, which assumes that symbol references can fit in a
+ * 32-bit slot. The system dynamic linker makes this work for
+ * references to shared libraries by either (a) allocating a jump
+ * table slot for code references, or (b) moving the symbol at load
+ * time (and copying its contents, if necessary) for data references.
+ *
+ * We unfortunately can't tell whether symbol references are to code
+ * or data. So for now we assume they are code (the vast majority
+ * are), and allocate jump-table slots. Unfortunately this will
+ * SILENTLY generate crashing code for data references. This hack is
+ * enabled by X86_64_ELF_NONPIC_HACK.
+ *
+ * One workaround is to use shared Haskell libraries. This is
+ * coming. Another workaround is to keep the static libraries but
+ * compile them with -fPIC, because that will generate PIC references
+ * to data which can be relocated. The PIC code is still too green to
+ * do this systematically, though.
+ *
+ * See bug #781
+ * See thread http://www.haskell.org/pipermail/cvs-ghc/2007-September/038458.html
+ */
+#define X86_64_ELF_NONPIC_HACK 1
/* -----------------------------------------------------------------------------
* Built-in symbols from the RTS
#if !defined (mingw32_HOST_OS)
#define RTS_POSIX_ONLY_SYMBOLS \
+ SymX(shutdownHaskellAndSignal) \
+ Sym(lockFile) \
+ Sym(unlockFile) \
SymX(signal_handlers) \
SymX(stg_sig_install) \
Sym(nocldstop)
#define RTS_MINGW_EXTRA_SYMS
#endif
+#if HAVE_GETTIMEOFDAY
+#define RTS_MINGW_GETTIMEOFDAY_SYM Sym(gettimeofday)
+#else
+#define RTS_MINGW_GETTIMEOFDAY_SYM /**/
+#endif
+
/* These are statically linked from the mingw libraries into the ghc
executable, so we have to employ this hack. */
#define RTS_MINGW_ONLY_SYMBOLS \
Sym(readdir) \
Sym(rewinddir) \
RTS_MINGW_EXTRA_SYMS \
+ RTS_MINGW_GETTIMEOFDAY_SYM \
Sym(closedir)
#endif
#define RTS_USER_SIGNALS_SYMBOLS \
SymX(setIOManagerPipe)
#else
-#define RTS_USER_SIGNALS_SYMBOLS /* nothing */
+#define RTS_USER_SIGNALS_SYMBOLS \
+ SymX(sendIOManagerEvent) \
+ SymX(readIOManagerEvent) \
+ SymX(getIOManagerEvent) \
+ SymX(console_handler)
#endif
+#define RTS_LIBFFI_SYMBOLS \
+ Sym(ffi_prep_cif) \
+ Sym(ffi_call) \
+ Sym(ffi_type_void) \
+ Sym(ffi_type_float) \
+ Sym(ffi_type_double) \
+ Sym(ffi_type_sint64) \
+ Sym(ffi_type_uint64) \
+ Sym(ffi_type_sint32) \
+ Sym(ffi_type_uint32) \
+ Sym(ffi_type_sint16) \
+ Sym(ffi_type_uint16) \
+ Sym(ffi_type_sint8) \
+ Sym(ffi_type_uint8) \
+ Sym(ffi_type_pointer)
+
#ifdef TABLES_NEXT_TO_CODE
#define RTS_RET_SYMBOLS /* nothing */
#else
SymX(stg_ap_pppppp_ret)
#endif
+/* On Windows, we link libgmp.a statically into libHSrts.dll */
+#ifdef mingw32_HOST_OS
+#define GMP_SYMS \
+ SymX(__gmpz_cmp) \
+ SymX(__gmpz_cmp_si) \
+ SymX(__gmpz_cmp_ui) \
+ SymX(__gmpz_get_si) \
+ SymX(__gmpz_get_ui)
+#else
+#define GMP_SYMS \
+ SymExtern(__gmpz_cmp) \
+ SymExtern(__gmpz_cmp_si) \
+ SymExtern(__gmpz_cmp_ui) \
+ SymExtern(__gmpz_get_si) \
+ SymExtern(__gmpz_get_ui)
+#endif
+
#define RTS_SYMBOLS \
Maybe_Stable_Names \
- Sym(StgReturn) \
+ SymX(StgReturn) \
SymX(stg_enter_info) \
SymX(stg_gc_void_info) \
SymX(__stg_gc_enter_1) \
SymX(stg_block_1) \
SymX(stg_block_takemvar) \
SymX(stg_block_putmvar) \
- SymX(stg_seq_frame_info) \
MAIN_CAP_SYM \
SymX(MallocFailHook) \
SymX(OnExitHook) \
SymX(__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) \
+ GMP_SYMS \
SymX(__int_encodeDouble) \
+ SymX(__word_encodeDouble) \
+ SymX(__2Int_encodeDouble) \
SymX(__int_encodeFloat) \
+ SymX(__word_encodeFloat) \
SymX(andIntegerzh_fast) \
SymX(atomicallyzh_fast) \
SymX(barf) \
SymX(debugBelch) \
SymX(errorBelch) \
+ SymX(asyncExceptionsBlockedzh_fast) \
SymX(blockAsyncExceptionszh_fast) \
SymX(catchzh_fast) \
SymX(catchRetryzh_fast) \
SymX(createAdjustor) \
SymX(decodeDoublezh_fast) \
SymX(decodeFloatzh_fast) \
+ SymX(decodeDoublezu2Intzh_fast) \
+ SymX(decodeFloatzuIntzh_fast) \
SymX(defaultsHook) \
SymX(delayzh_fast) \
SymX(deRefWeakzh_fast) \
SymX(genSymZh) \
SymX(genericRaise) \
SymX(getProgArgv) \
+ SymX(getFullProgArgv) \
SymX(getStablePtr) \
SymX(hs_init) \
SymX(hs_exit) \
SymX(hs_perform_gc) \
SymX(hs_free_stable_ptr) \
SymX(hs_free_fun_ptr) \
+ SymX(hs_hpc_rootModule) \
SymX(initLinker) \
+ SymX(unpackClosurezh_fast) \
+ SymX(getApStackValzh_fast) \
SymX(int2Integerzh_fast) \
SymX(integer2Intzh_fast) \
SymX(integer2Wordzh_fast) \
SymX(newMVarzh_fast) \
SymX(newMutVarzh_fast) \
SymX(newTVarzh_fast) \
+ SymX(noDuplicatezh_fast) \
SymX(atomicModifyMutVarzh_fast) \
SymX(newPinnedByteArrayzh_fast) \
SymX(newSpark) \
SymX(rts_getDouble) \
SymX(rts_getFloat) \
SymX(rts_getInt) \
+ SymX(rts_getInt8) \
+ SymX(rts_getInt16) \
SymX(rts_getInt32) \
+ SymX(rts_getInt64) \
SymX(rts_getPtr) \
SymX(rts_getFunPtr) \
SymX(rts_getStablePtr) \
SymX(rts_getThreadId) \
SymX(rts_getWord) \
+ SymX(rts_getWord8) \
+ SymX(rts_getWord16) \
SymX(rts_getWord32) \
+ SymX(rts_getWord64) \
SymX(rts_lock) \
SymX(rts_mkBool) \
SymX(rts_mkChar) \
SymX(rts_mkDouble) \
SymX(rts_mkFloat) \
SymX(rts_mkInt) \
+ SymX(rts_mkInt8) \
SymX(rts_mkInt16) \
SymX(rts_mkInt32) \
SymX(rts_mkInt64) \
- SymX(rts_mkInt8) \
SymX(rts_mkPtr) \
SymX(rts_mkFunPtr) \
SymX(rts_mkStablePtr) \
SymX(rts_mkString) \
SymX(rts_mkWord) \
+ SymX(rts_mkWord8) \
SymX(rts_mkWord16) \
SymX(rts_mkWord32) \
SymX(rts_mkWord64) \
- SymX(rts_mkWord8) \
SymX(rts_unlock) \
SymX(rtsSupportsBoundThreads) \
SymX(__hscore_get_saved_termios) \
SymX(stg_CAF_BLACKHOLE_info) \
SymX(awakenBlockedQueue) \
SymX(stg_CHARLIKE_closure) \
- SymX(stg_EMPTY_MVAR_info) \
+ SymX(stg_MVAR_CLEAN_info) \
+ SymX(stg_MVAR_DIRTY_info) \
SymX(stg_IND_STATIC_info) \
SymX(stg_INTLIKE_closure) \
SymX(stg_MUT_ARR_PTRS_DIRTY_info) \
SymX(stg_upd_frame_info) \
SymX(suspendThread) \
SymX(takeMVarzh_fast) \
+ SymX(threadStatuszh_fast) \
SymX(timesIntegerzh_fast) \
SymX(tryPutMVarzh_fast) \
SymX(tryTakeMVarzh_fast) \
SymX(writeTVarzh_fast) \
SymX(xorIntegerzh_fast) \
SymX(yieldzh_fast) \
- SymX(stg_interp_constr_entry) \
- SymX(stg_interp_constr1_entry) \
- SymX(stg_interp_constr2_entry) \
- SymX(stg_interp_constr3_entry) \
- SymX(stg_interp_constr4_entry) \
- SymX(stg_interp_constr5_entry) \
- SymX(stg_interp_constr6_entry) \
- SymX(stg_interp_constr7_entry) \
- SymX(stg_interp_constr8_entry) \
+ Sym(stg_interp_constr_entry) \
SymX(allocateExec) \
SymX(freeExec) \
SymX(getAllocations) \
SymX(revertCAFs) \
SymX(RtsFlags) \
+ Sym(rts_breakpoint_io_action) \
+ Sym(rts_stop_next_breakpoint) \
+ Sym(rts_stop_on_exception) \
+ SymX(stopTimer) \
+ SymX(n_capabilities) \
RTS_USER_SIGNALS_SYMBOLS
#ifdef SUPPORT_LONG_LONGS
/* entirely bogus claims about types of these symbols */
#define Sym(vvv) extern void vvv(void);
+#if defined(__PIC__) && defined(mingw32_TARGET_OS)
+#define SymExtern(vvv) extern void _imp__ ## vvv (void);
+#else
+#define SymExtern(vvv) SymX(vvv)
+#endif
#define SymX(vvv) /**/
#define SymX_redirect(vvv,xxx) /**/
RTS_SYMBOLS
RTS_CYGWIN_ONLY_SYMBOLS
RTS_DARWIN_ONLY_SYMBOLS
RTS_LIBGCC_SYMBOLS
+RTS_LIBFFI_SYMBOLS
#undef Sym
#undef SymX
#undef SymX_redirect
+#undef SymExtern
#ifdef LEADING_UNDERSCORE
#define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
#define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
(void*)(&(vvv)) },
#define SymX(vvv) Sym(vvv)
+#define SymExtern(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
+ (void*)DLL_IMPORT_DATA_REF(vvv) },
// SymX_redirect allows us to redirect references to one symbol to
// another symbol. See newCAF/newDynCAF for an example.
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
};
-/* -----------------------------------------------------------------------------
- * Utilities for handling root pointers.
- * -------------------------------------------------------------------------- */
-
-
-#define INIT_RPT_SIZE 64
-
-STATIC_INLINE void
-initFreeList(rootEntry *table, nat n, rootEntry *free)
-{
- rootEntry *p;
-
- for (p = table + n - 1; p >= table; p--) {
- p->addr = (P_)free;
- free = p;
- }
- root_ptr_free = table;
-}
-
-static void
-initRootPtrTable(void)
-{
- if (RPT_size > 0)
- return;
-
- RPT_size = INIT_RPT_SIZE;
- root_ptr_table = stgMallocBytes(RPT_size * sizeof(rootEntry),
- "initRootPtrTable");
-
- initFreeList(root_ptr_table,INIT_RPT_SIZE,NULL);
-}
-
-
-static void
-enlargeRootPtrTable(void)
-{
- nat old_RPT_size = RPT_size;
-
- // 2nd and subsequent times
- RPT_size *= 2;
- root_ptr_table =
- stgReallocBytes(root_ptr_table,
- RPT_size * sizeof(rootEntry),
- "enlargeRootPtrTable");
-
- initFreeList(root_ptr_table + old_RPT_size, old_RPT_size, NULL);
-}
-
-static void
-addRootObject(void *addr)
-{
- StgWord rt;
- initRootPtrTable();
- if (root_ptr_free == NULL) {
- enlargeRootPtrTable();
- }
-
- rt = root_ptr_free - root_ptr_table;
- root_ptr_free = (rootEntry*)(root_ptr_free->addr);
- root_ptr_table[rt].addr = addr;
-}
-
-/* -----------------------------------------------------------------------------
- * Treat root pointers as roots for the garbage collector.
- * -------------------------------------------------------------------------- */
-
-void
-markRootPtrTable(evac_fn evac)
-{
- rootEntry *p, *end_root_ptr_table;
- StgPtr q;
-
- end_root_ptr_table = &root_ptr_table[RPT_size];
-
- for (p = root_ptr_table; p < end_root_ptr_table; p++) {
- q = p->addr;
-
- if (q && (q < (P_)root_ptr_table || q >= (P_)end_root_ptr_table)) {
- evac((StgClosure **)p->addr);
- }
- }
-}
-
-/* -----------------------------------------------------------------------------
- * End of utilities for handling root pointers.
- * -------------------------------------------------------------------------- */
-
/* -----------------------------------------------------------------------------
* Insert symbols into hash tables, checking for duplicates.
*/
+
static void ghciInsertStrHashTable ( char* obj_name,
HashTable *table,
char* key,
);
exit(1);
}
-
-
/* -----------------------------------------------------------------------------
* initialize the object linker
*/
static OpenedDLL* opened_dlls = NULL;
#endif
-char *
+const char *
addDLL( char *dll_name )
{
# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
/* ------------------- ELF DLL loader ------------------- */
void *hdl;
- char *errmsg;
+ const char *errmsg;
initLinker();
if (val == NULL) {
# if defined(OBJFORMAT_ELF)
-# if defined(x86_64_HOST_ARCH)
- val = dlsym(dl_prog_handle, lbl);
- if (val >= (void *)0x80000000) {
- void *new_val;
- new_val = x86_64_high_symbol(lbl, val);
- IF_DEBUG(linker,debugBelch("lookupSymbol: relocating out of range symbol: %s = %p, now %p\n", lbl, val, new_val));
- return new_val;
- } else {
- return val;
- }
-# else
return dlsym(dl_prog_handle, lbl);
-# endif
# elif defined(OBJFORMAT_MACHO)
+# if HAVE_DLFCN_H
+ /* On OS X 10.3 and later, we use dlsym instead of the old legacy
+ interface.
+
+ HACK: On OS X, global symbols are prefixed with an underscore.
+ However, dlsym wants us to omit the leading underscore from the
+ symbol name. For now, we simply strip it off here (and ONLY
+ here).
+ */
+ ASSERT(lbl[0] == '_');
+ return dlsym(dl_prog_handle, lbl+1);
+# else
if(NSIsSymbolNameDefined(lbl)) {
NSSymbol symbol = NSLookupAndBindSymbol(lbl);
return NSAddressOfSymbol(symbol);
} else {
return NULL;
}
+# endif /* HAVE_DLFCN_H */
# elif defined(OBJFORMAT_PEi386)
OpenedDLL* o_dll;
void* sym;
void *map_addr = NULL;
#else
FILE *f;
- int misalignment;
#endif
initLinker();
/* debugBelch("loadObj %s\n", path ); */
- /* Check that we haven't already loaded this object.
+ /* Check that we haven't already loaded this object.
Ignore requests to load multiple times */
{
ObjectCode *o;
/* 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
*/
-#ifdef x86_64_HOST_ARCH
+#if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
#define EXTRA_MAP_FLAGS MAP_32BIT
#else
#define EXTRA_MAP_FLAGS 0
#endif
- oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE,
+ /* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
+#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
+#define MAP_ANONYMOUS MAP_ANON
+#endif
+
+ oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE,
MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
if (oc->image == MAP_FAILED)
barf("loadObj: can't map `%s'", path);
if (!f)
barf("loadObj: can't read `%s'", path);
-#ifdef darwin_HOST_OS
+# if defined(mingw32_HOST_OS)
+ // TODO: We would like to use allocateExec here, but allocateExec
+ // cannot currently allocate blocks large enough.
+ oc->image = VirtualAlloc(NULL, oc->fileSize, MEM_RESERVE | MEM_COMMIT,
+ PAGE_EXECUTE_READWRITE);
+# elif defined(darwin_HOST_OS)
// In a Mach-O .o file, all sections can and will be misaligned
// if the total size of the headers is not a multiple of the
// desired alignment. This is fine for .o files that only serve
// We calculate the correct alignment from the header before
// reading the file, and then we misalign oc->image on purpose so
// that the actual sections end up aligned again.
- misalignment = machoGetMisalignment(f);
- oc->misalignment = misalignment;
-#else
- misalignment = 0;
-#endif
+ oc->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
- oc->image = stgMallocBytes(oc->fileSize + misalignment, "loadObj(image)");
- oc->image += misalignment;
-
n = fread ( oc->image, 1, oc->fileSize, f );
if (n != oc->fileSize)
barf("loadObj: error whilst reading `%s'", path);
fclose(f);
-
#endif /* USE_MMAP */
-# if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
- r = ocAllocateJumpIslands_MachO ( oc );
+# if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
+ r = ocAllocateSymbolExtras_MachO ( oc );
if (!r) { return r; }
-# elif defined(OBJFORMAT_ELF) && defined(powerpc_HOST_ARCH)
- r = ocAllocateJumpIslands_ELF ( oc );
+# elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
+ r = ocAllocateSymbolExtras_ELF ( oc );
if (!r) { return r; }
#endif
prev->next = oc->next;
}
- /* We're going to leave this in place, in case there are
- any pointers from the heap into it: */
- /* stgFree(oc->image); */
+ // We're going to leave this in place, in case there are
+ // any pointers from the heap into it:
+ // #ifdef mingw32_HOST_OS
+ // VirtualFree(oc->image);
+ // #else
+ // stgFree(oc->image);
+ // #endif
stgFree(oc->fileName);
stgFree(oc->symbols);
stgFree(oc->sections);
/* --------------------------------------------------------------------------
- * 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 )
{
#ifdef USE_MMAP
#ifndef linux_HOST_OS /* mremap is a linux extension */
- #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined
+ #error ocAllocateSymbolExtras doesnt want USE_MMAP to be defined
#endif
pagesize = getpagesize();
n = ROUND_UP( oc->fileSize, pagesize );
- m = ROUND_UP( aligned + sizeof (ppcJumpIsland) * count, pagesize );
+ m = ROUND_UP( aligned + sizeof (SymbolExtra) * count, pagesize );
/* If we have a half-page-size file and map one page of it then
* the part of the page after the size of the file remains accessible.
oc->image -= misalignment;
oc->image = stgReallocBytes( oc->image,
misalignment +
- aligned + sizeof (ppcJumpIsland) * count,
- "ocAllocateJumpIslands" );
+ aligned + sizeof (SymbolExtra) * count,
+ "ocAllocateSymbolExtras" );
oc->image += misalignment;
#endif /* USE_MMAP */
- oc->jump_islands = (ppcJumpIsland *) (oc->image + aligned);
- memset( oc->jump_islands, 0, sizeof (ppcJumpIsland) * count );
+ oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
+ memset( oc->symbol_extras, 0, sizeof (SymbolExtra) * count );
}
else
- oc->jump_islands = NULL;
+ oc->symbol_extras = NULL;
- oc->island_start_symbol = first;
- oc->n_islands = count;
+ oc->first_symbol_extra = first;
+ oc->n_symbol_extras = count;
return 1;
}
-static unsigned long makeJumpIsland( ObjectCode* oc,
+static SymbolExtra* makeSymbolExtra( ObjectCode* oc,
unsigned long symbolNumber,
unsigned long target )
{
- ppcJumpIsland *island;
+ SymbolExtra *extra;
- if( symbolNumber < oc->island_start_symbol ||
- symbolNumber - oc->island_start_symbol > oc->n_islands)
- return 0;
+ ASSERT( symbolNumber >= oc->first_symbol_extra
+ && symbolNumber - oc->first_symbol_extra < oc->n_symbol_extras);
- island = &oc->jump_islands[symbolNumber - oc->island_start_symbol];
+ extra = &oc->symbol_extras[symbolNumber - oc->first_symbol_extra];
+#ifdef powerpc_HOST_ARCH
// lis r12, hi16(target)
- island->lis_r12 = 0x3d80;
- island->hi_addr = target >> 16;
+ extra->jumpIsland.lis_r12 = 0x3d80;
+ extra->jumpIsland.hi_addr = target >> 16;
// ori r12, r12, lo16(target)
- island->ori_r12_r12 = 0x618c;
- island->lo_addr = target & 0xffff;
+ extra->jumpIsland.ori_r12_r12 = 0x618c;
+ extra->jumpIsland.lo_addr = target & 0xffff;
// mtctr r12
- island->mtctr_r12 = 0x7d8903a6;
+ extra->jumpIsland.mtctr_r12 = 0x7d8903a6;
// bctr
- island->bctr = 0x4e800420;
+ extra->jumpIsland.bctr = 0x4e800420;
+#endif
+#ifdef x86_64_HOST_ARCH
+ // jmp *-14(%rip)
+ static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
+ extra->addr = target;
+ memcpy(extra->jumpIsland, jmp, 6);
+#endif
- return (unsigned long) island;
+ return extra;
}
+#endif
+
+/* --------------------------------------------------------------------------
+ * PowerPC specifics (instruction cache flushing)
+ * ------------------------------------------------------------------------*/
+
+#ifdef powerpc_TARGET_ARCH
/*
ocFlushInstructionCache
static void ocFlushInstructionCache( ObjectCode *oc )
{
- int n = (oc->fileSize + sizeof( ppcJumpIsland ) * oc->n_islands + 3) / 4;
+ int n = (oc->fileSize + sizeof( SymbolExtra ) * oc->n_symbol_extras + 3) / 4;
unsigned long *p = (unsigned long *) oc->image;
while( n-- )
&& 0 != strcmp(".ctors", sectab_i->Name)
/* ignore section generated from .ident */
&& 0!= strcmp("/4", sectab_i->Name)
+ /* ignore unknown section that appeared in gcc 3.4.5(?) */
+ && 0!= strcmp(".reloc", sectab_i->Name)
) {
errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
return 0;
#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
*/
#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
*/
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;
}
S = (Elf_Addr)S_tmp;
} else {
stableVal = deRefStablePtr( stablePtr );
- addRootObject((void*)P);
S_tmp = stableVal;
S = (Elf_Addr)S_tmp;
}
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;
}
{
StgInt64 off = value - P;
if (off >= 0x7fffffffL || off < -0x80000000L) {
- barf("R_X86_64_PC32 relocation out of range: %s = %p",
- symbol, off);
- }
+#if X86_64_ELF_NONPIC_HACK
+ StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
+ -> jumpIsland;
+ off = pltAddress + A - P;
+#else
+ barf("R_X86_64_PC32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
+ symbol, off, oc->fileName );
+#endif
+ }
+ *(Elf64_Word *)P = (Elf64_Word)off;
+ break;
+ }
+
+ case R_X86_64_PC64:
+ {
+ StgInt64 off = value - P;
*(Elf64_Word *)P = (Elf64_Word)off;
break;
}
case R_X86_64_32:
if (value >= 0x7fffffffL) {
- barf("R_X86_64_32 relocation out of range: %s = %p\n",
- symbol, value);
- }
+#if X86_64_ELF_NONPIC_HACK
+ StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
+ -> jumpIsland;
+ value = pltAddress + A;
+#else
+ barf("R_X86_64_32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
+ symbol, value, oc->fileName );
+#endif
+ }
*(Elf64_Word *)P = (Elf64_Word)value;
break;
case R_X86_64_32S:
if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
- barf("R_X86_64_32S relocation out of range: %s = %p\n",
- symbol, value);
+#if X86_64_ELF_NONPIC_HACK
+ StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
+ -> jumpIsland;
+ value = pltAddress + A;
+#else
+ barf("R_X86_64_32S relocation out of range: %s = %p\nRecompile %s with -fPIC.",
+ symbol, value, oc->fileName );
+#endif
}
*(Elf64_Sword *)P = (Elf64_Sword)value;
break;
+
+ case R_X86_64_GOTPCREL:
+ {
+ StgInt64 gotAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)->addr;
+ StgInt64 off = gotAddress + A - P;
+ *(Elf64_Word *)P = (Elf64_Word)off;
+ break;
+ }
+
+ case R_X86_64_PLT32:
+ {
+ StgInt64 off = value - P;
+ if (off >= 0x7fffffffL || off < -0x80000000L) {
+ StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
+ -> jumpIsland;
+ off = pltAddress + A - P;
+ }
+ *(Elf64_Word *)P = (Elf64_Word)off;
+ break;
+ }
#endif
default:
#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( 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);
}
}
if(max >= min)
- return ocAllocateJumpIslands(oc, max - min + 1, min);
+ return ocAllocateSymbolExtras(oc, max - min + 1, min);
break;
}
lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
}
- return ocAllocateJumpIslands(oc,0,0);
+ return ocAllocateSymbolExtras(oc,0,0);
+}
+#endif
+#ifdef x86_64_HOST_ARCH
+static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
+{
+ struct mach_header *header = (struct mach_header *) oc->image;
+ struct load_command *lc = (struct load_command *) (header + 1);
+ unsigned i;
+
+ for( i = 0; i < header->ncmds; i++ )
+ {
+ if( lc->cmd == LC_SYMTAB )
+ {
+ // Just allocate one entry for every symbol
+ struct symtab_command *symLC = (struct symtab_command *) lc;
+
+ return ocAllocateSymbolExtras(oc, symLC->nsyms, 0);
+ }
+
+ lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
+ }
+ return ocAllocateSymbolExtras(oc,0,0);
}
#endif
-static int ocVerifyImage_MachO(ObjectCode* oc STG_UNUSED)
+static int ocVerifyImage_MachO(ObjectCode* oc)
{
- // FIXME: do some verifying here
+ char *image = (char*) oc->image;
+ struct mach_header *header = (struct mach_header*) image;
+
+#if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
+ if(header->magic != MH_MAGIC_64)
+ return 0;
+#else
+ if(header->magic != MH_MAGIC)
+ return 0;
+#endif
+ // FIXME: do some more verifying here
return 1;
}
for(i=0;i<n;i++)
{
+#ifdef x86_64_HOST_ARCH
+ struct relocation_info *reloc = &relocs[i];
+
+ char *thingPtr = image + sect->offset + reloc->r_address;
+ uint64_t thing;
+ uint64_t value;
+ uint64_t baseValue;
+ int type = reloc->r_type;
+
+ checkProddableBlock(oc,thingPtr);
+ switch(reloc->r_length)
+ {
+ case 0:
+ thing = *(uint8_t*)thingPtr;
+ baseValue = (uint64_t)thingPtr + 1;
+ break;
+ case 1:
+ thing = *(uint16_t*)thingPtr;
+ baseValue = (uint64_t)thingPtr + 2;
+ break;
+ case 2:
+ thing = *(uint32_t*)thingPtr;
+ baseValue = (uint64_t)thingPtr + 4;
+ break;
+ case 3:
+ thing = *(uint64_t*)thingPtr;
+ baseValue = (uint64_t)thingPtr + 8;
+ break;
+ default:
+ barf("Unknown size.");
+ }
+
+ if(type == X86_64_RELOC_GOT
+ || type == X86_64_RELOC_GOT_LOAD)
+ {
+ ASSERT(reloc->r_extern);
+ value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)->addr;
+
+ type = X86_64_RELOC_SIGNED;
+ }
+ else if(reloc->r_extern)
+ {
+ struct nlist *symbol = &nlist[reloc->r_symbolnum];
+ char *nm = image + symLC->stroff + symbol->n_un.n_strx;
+ if(symbol->n_value == 0)
+ value = (uint64_t) lookupSymbol(nm);
+ else
+ value = relocateAddress(oc, nSections, sections,
+ symbol->n_value);
+ }
+ else
+ {
+ value = sections[reloc->r_symbolnum-1].offset
+ - sections[reloc->r_symbolnum-1].addr
+ + (uint64_t) image;
+ }
+
+ if(type == X86_64_RELOC_BRANCH)
+ {
+ if((int32_t)(value - baseValue) != (int64_t)(value - baseValue))
+ {
+ ASSERT(reloc->r_extern);
+ value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)
+ -> jumpIsland;
+ }
+ ASSERT((int32_t)(value - baseValue) == (int64_t)(value - baseValue));
+ type = X86_64_RELOC_SIGNED;
+ }
+
+ switch(type)
+ {
+ case X86_64_RELOC_UNSIGNED:
+ ASSERT(!reloc->r_pcrel);
+ thing += value;
+ break;
+ case X86_64_RELOC_SIGNED:
+ ASSERT(reloc->r_pcrel);
+ thing += value - baseValue;
+ break;
+ case X86_64_RELOC_SUBTRACTOR:
+ ASSERT(!reloc->r_pcrel);
+ thing -= value;
+ break;
+ default:
+ barf("unkown relocation");
+ }
+
+ switch(reloc->r_length)
+ {
+ case 0:
+ *(uint8_t*)thingPtr = thing;
+ break;
+ case 1:
+ *(uint16_t*)thingPtr = thing;
+ break;
+ case 2:
+ *(uint32_t*)thingPtr = thing;
+ break;
+ case 3:
+ *(uint64_t*)thingPtr = thing;
+ break;
+ }
+#else
if(relocs[i].r_address & R_SCATTERED)
{
struct scattered_relocation_info *scat =
#ifdef powerpc_HOST_ARCH
// In the .o file, this should be a relative jump to NULL
// and we'll change it to a relative jump to the symbol
- ASSERT(-word == reloc->r_address);
- jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,(unsigned long) symbolAddress);
+ ASSERT(word + reloc->r_address == 0);
+ jumpIsland = (unsigned long)
+ &makeSymbolExtra(oc,
+ reloc->r_symbolnum,
+ (unsigned long) symbolAddress)
+ -> jumpIsland;
if(jumpIsland != 0)
{
offsetToJumpIsland = word + jumpIsland
barf("\nunknown relocation %d",reloc->r_type);
return 0;
}
+#endif
}
return 1;
}
for(i=0;i<header->ncmds;i++)
{
- if(lc->cmd == LC_SEGMENT)
+ if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
segLC = (struct segment_command*) lc;
else if(lc->cmd == LC_SYMTAB)
symLC = (struct symtab_command*) lc;
sections = (struct section*) (segLC+1);
nlist = symLC ? (struct nlist*) (image + symLC->symoff)
: NULL;
+
+ if(!segLC)
+ barf("ocGetNames_MachO: no segment load command");
for(i=0;i<segLC->nsects;i++)
{
if(nlist[i].n_type & N_EXT)
{
char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
- ghciInsertStrHashTable(oc->fileName, symhash, nm,
- image
- + sections[nlist[i].n_sect-1].offset
- - sections[nlist[i].n_sect-1].addr
- + nlist[i].n_value);
- oc->symbols[curSymbol++] = nm;
- }
- else
- {
- char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
- ghciInsertStrHashTable(oc->fileName, oc->lochash, nm,
- image
- + sections[nlist[i].n_sect-1].offset
- - sections[nlist[i].n_sect-1].addr
- + nlist[i].n_value);
+ if((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm))
+ ; // weak definition, and we already have a definition
+ else
+ {
+ ghciInsertStrHashTable(oc->fileName, symhash, nm,
+ image
+ + sections[nlist[i].n_sect-1].offset
+ - sections[nlist[i].n_sect-1].addr
+ + nlist[i].n_value);
+ oc->symbols[curSymbol++] = nm;
+ }
}
}
}
for(i=0;i<header->ncmds;i++)
{
- if(lc->cmd == LC_SEGMENT)
+ if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
segLC = (struct segment_command*) lc;
else if(lc->cmd == LC_SYMTAB)
symLC = (struct symtab_command*) lc;
fread(&header, sizeof(header), 1, f);
rewind(f);
+#if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
+ if(header.magic != MH_MAGIC_64)
+ return 0;
+#else
if(header.magic != MH_MAGIC)
return 0;
-
+#endif
+
misalignment = (header.sizeofcmds + sizeof(header))
& 0xF;
}
#endif
+