don't make -ddump-if-trace imply -no-recomp
[ghc-hetmet.git] / rts / Linker.c
index bd0b543..bca6026 100644 (file)
 #  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 */
@@ -102,8 +107,8 @@ 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 );
@@ -115,15 +120,38 @@ static int ocGetNames_MachO       ( ObjectCode* oc );
 static int ocResolve_MachO        ( ObjectCode* oc );
 
 static int machoGetMisalignment( FILE * );
+#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
+static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
+#endif
 #ifdef powerpc_HOST_ARCH
-static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
 static void machoInitSymbolsWithoutUnderscore( void );
 #endif
 #endif
 
-#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
@@ -146,6 +174,8 @@ typedef struct _RtsSymbolVal {
 
 #if !defined (mingw32_HOST_OS)
 #define RTS_POSIX_ONLY_SYMBOLS                  \
+      Sym(lockFile)                             \
+      Sym(unlockFile)                           \
       SymX(signal_handlers)                    \
       SymX(stg_sig_install)                    \
       Sym(nocldstop)
@@ -251,6 +281,12 @@ typedef struct _RtsSymbolVal {
 #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                  \
@@ -334,6 +370,7 @@ typedef struct _RtsSymbolVal {
       Sym(readdir)                              \
       Sym(rewinddir)                            \
       RTS_MINGW_EXTRA_SYMS                      \
+      RTS_MINGW_GETTIMEOFDAY_SYM               \
       Sym(closedir)
 #endif
 
@@ -404,6 +441,22 @@ typedef struct _RtsSymbolVal {
    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
@@ -426,9 +479,26 @@ typedef struct _RtsSymbolVal {
       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)                   \
@@ -457,7 +527,6 @@ typedef struct _RtsSymbolVal {
       SymX(stg_block_1)                                \
       SymX(stg_block_takemvar)                 \
       SymX(stg_block_putmvar)                  \
-      SymX(stg_seq_frame_info)                 \
       MAIN_CAP_SYM                              \
       SymX(MallocFailHook)                     \
       SymX(OnExitHook)                         \
@@ -466,13 +535,9 @@ typedef struct _RtsSymbolVal {
       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(__2Int_encodeDouble)                        \
       SymX(__int_encodeFloat)                  \
       SymX(andIntegerzh_fast)                  \
       SymX(atomicallyzh_fast)                  \
@@ -492,6 +557,8 @@ typedef struct _RtsSymbolVal {
       SymX(createAdjustor)                     \
       SymX(decodeDoublezh_fast)                        \
       SymX(decodeFloatzh_fast)                 \
+      SymX(decodeDoublezu2Intzh_fast)                  \
+      SymX(decodeFloatzuIntzh_fast)                    \
       SymX(defaultsHook)                       \
       SymX(delayzh_fast)                       \
       SymX(deRefWeakzh_fast)                   \
@@ -512,6 +579,7 @@ typedef struct _RtsSymbolVal {
       SymX(genSymZh)                           \
       SymX(genericRaise)                       \
       SymX(getProgArgv)                                \
+      SymX(getFullProgArgv)                            \
       SymX(getStablePtr)                       \
       SymX(hs_init)                            \
       SymX(hs_exit)                            \
@@ -520,7 +588,10 @@ typedef struct _RtsSymbolVal {
       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)                        \
@@ -551,6 +622,7 @@ typedef struct _RtsSymbolVal {
       SymX(newMVarzh_fast)                     \
       SymX(newMutVarzh_fast)                   \
       SymX(newTVarzh_fast)                     \
+      SymX(noDuplicatezh_fast)                 \
       SymX(atomicModifyMutVarzh_fast)          \
       SymX(newPinnedByteArrayzh_fast)          \
       SymX(newSpark)                           \
@@ -583,32 +655,38 @@ typedef struct _RtsSymbolVal {
       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)         \
@@ -622,7 +700,8 @@ typedef struct _RtsSymbolVal {
       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)                \
@@ -697,20 +776,17 @@ typedef struct _RtsSymbolVal {
       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
@@ -756,6 +832,11 @@ typedef struct _RtsSymbolVal {
 
 /* 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
@@ -766,9 +847,11 @@ RTS_MINGW_ONLY_SYMBOLS
 RTS_CYGWIN_ONLY_SYMBOLS
 RTS_DARWIN_ONLY_SYMBOLS
 RTS_LIBGCC_SYMBOLS
+RTS_LIBFFI_SYMBOLS
 #undef Sym
 #undef SymX
 #undef SymX_redirect
+#undef SymExtern
 
 #ifdef LEADING_UNDERSCORE
 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
@@ -779,6 +862,8 @@ RTS_LIBGCC_SYMBOLS
 #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.
@@ -795,6 +880,7 @@ static RtsSymbolVal rtsSyms[] = {
       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
@@ -806,10 +892,10 @@ static RtsSymbolVal rtsSyms[] = {
 
 
 
-
 /* -----------------------------------------------------------------------------
  * Insert symbols into hash tables, checking for duplicates.
  */
+
 static void ghciInsertStrHashTable ( char* obj_name,
                                      HashTable *table,
                                      char* key,
@@ -839,8 +925,6 @@ static void ghciInsertStrHashTable ( char* obj_name,
    );
    exit(1);
 }
-
-
 /* -----------------------------------------------------------------------------
  * initialize the object linker
  */
@@ -920,13 +1004,13 @@ typedef
 static OpenedDLL* opened_dlls = NULL;
 #endif
 
-char *
+const char *
 addDLL( char *dll_name )
 {
 #  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
    /* ------------------- ELF DLL loader ------------------- */
    void *hdl;
-   char *errmsg;
+   const char *errmsg;
 
    initLinker();
 
@@ -1031,26 +1115,27 @@ lookupSymbol( char *lbl )
 
     if (val == NULL) {
 #       if defined(OBJFORMAT_ELF)
-#      if defined(x86_64_HOST_ARCH)
-       val = dlsym(dl_prog_handle, lbl);
-       if (val >= (void *)0x80000000) {
-           void *new_val;
-           new_val = x86_64_high_symbol(lbl, val);
-           IF_DEBUG(linker,debugBelch("lookupSymbol: relocating out of range symbol: %s = %p, now %p\n", lbl, val, new_val));
-           return new_val;
-       } else {
-           return val;
-       }
-#      else
        return dlsym(dl_prog_handle, lbl);
-#      endif
 #       elif defined(OBJFORMAT_MACHO)
+#       if HAVE_DLFCN_H
+        /* On OS X 10.3 and later, we use dlsym instead of the old legacy
+           interface.
+
+           HACK: On OS X, global symbols are prefixed with an underscore.
+                 However, dlsym wants us to omit the leading underscore from the
+                 symbol name. For now, we simply strip it off here (and ONLY
+                 here).
+        */
+        ASSERT(lbl[0] == '_');
+        return dlsym(dl_prog_handle, lbl+1);
+#       else
        if(NSIsSymbolNameDefined(lbl)) {
            NSSymbol symbol = NSLookupAndBindSymbol(lbl);
            return NSAddressOfSymbol(symbol);
        } else {
            return NULL;
        }
+#       endif /* HAVE_DLFCN_H */
 #       elif defined(OBJFORMAT_PEi386)
         OpenedDLL* o_dll;
         void* sym;
@@ -1249,13 +1334,20 @@ loadObj( char *path )
    /* 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
 
+   /* 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)
@@ -1286,7 +1378,8 @@ loadObj( char *path )
     // 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 + misalignment, "loadObj(image)");
+   oc->image = stgMallocBytes(oc->fileSize + oc->misalignment, "loadObj(image)");
+   oc->image += oc->misalignment;
 #  else
    oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
 #  endif
@@ -1296,14 +1389,13 @@ loadObj( char *path )
       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
 
@@ -1477,37 +1569,46 @@ static void addSection ( ObjectCode* oc, SectionKind kind,
 
 
 /* --------------------------------------------------------------------------
- * PowerPC specifics (jump islands)
- * ------------------------------------------------------------------------*/
+ * Symbol Extras.
+ * This is about allocating a small chunk of memory for every symbol in the
+ * object file. We make sure that the SymboLExtras are always "in range" of
+ * limited-range PC-relative instructions on various platforms by allocating
+ * them right next to the object code itself.
+ */
 
-#if defined(powerpc_HOST_ARCH)
+#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
 
 /*
-  ocAllocateJumpIslands
+  ocAllocateSymbolExtras
 
   Allocate additional space at the end of the object file image to make room
-  for jump islands.
+  for jump islands (powerpc, x86_64) and GOT entries (x86_64).
   
   PowerPC relative branch instructions have a 24 bit displacement field.
   As PPC code is always 4-byte-aligned, this yields a +-32MB range.
   If a particular imported symbol is outside this range, we have to redirect
   the jump to a short piece of new code that just loads the 32bit absolute
   address and jumps there.
-  This function just allocates space for one 16 byte ppcJumpIsland for every
-  undefined symbol in the object file. The code for the islands is filled in by
-  makeJumpIsland below.
+  On x86_64, PC-relative jumps and PC-relative accesses to the GOT are limited
+  to 32 bits (+-2GB).
+  
+  This function just allocates space for one SymbolExtra for every
+  undefined symbol in the object file. The code for the jump islands is
+  filled in by makeSymbolExtra below.
 */
 
-static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first )
+static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
 {
 #ifdef USE_MMAP
   int pagesize, n, m;
 #endif
   int aligned;
+#ifndef USE_MMAP
   int misalignment = 0;
-#if darwin_HOST_OS
+#ifdef darwin_HOST_OS
   misalignment = oc->misalignment;
 #endif
+#endif
 
   if( count > 0 )
   {
@@ -1516,12 +1617,12 @@ static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first )
 
 #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.
@@ -1560,52 +1661,66 @@ static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first )
     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
 
@@ -1616,7 +1731,7 @@ static unsigned long makeJumpIsland( ObjectCode* oc,
 
 static void ocFlushInstructionCache( ObjectCode *oc )
 {
-    int n = (oc->fileSize + sizeof( ppcJumpIsland ) * oc->n_islands + 3) / 4;
+    int n = (oc->fileSize + sizeof( SymbolExtra ) * oc->n_symbol_extras + 3) / 4;
     unsigned long *p = (unsigned long *) oc->image;
 
     while( n-- )
@@ -2191,6 +2306,8 @@ ocGetNames_PEi386 ( ObjectCode* oc )
           && 0 != strcmp(".ctors", sectab_i->Name)
           /* ignore section generated from .ident */
           && 0!= strcmp("/4", sectab_i->Name)
+         /* ignore unknown section that appeared in gcc 3.4.5(?) */
+          && 0!= strcmp(".reloc", sectab_i->Name)
          ) {
          errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
          return 0;
@@ -2496,15 +2613,20 @@ ocResolve_PEi386 ( ObjectCode* oc )
 #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
  */
@@ -2669,64 +2791,6 @@ PLTSize(void)
 #endif
 
 
-#if x86_64_HOST_ARCH
-// On x86_64, 32-bit relocations are often used, which requires that
-// we can resolve a symbol to a 32-bit offset.  However, shared
-// libraries are placed outside the 2Gb area, which leaves us with a
-// problem when we need to give a 32-bit offset to a symbol in a
-// shared library.
-// 
-// For a function symbol, we can allocate a bounce sequence inside the
-// 2Gb area and resolve the symbol to this.  The bounce sequence is
-// simply a long jump instruction to the real location of the symbol.
-//
-// For data references, we're screwed.
-//
-typedef struct {
-    unsigned char jmp[8];  /* 6 byte instruction: jmpq *0x00000002(%rip) */
-    void *addr;
-} x86_64_bounce;
-
-#define X86_64_BB_SIZE 1024
-
-static x86_64_bounce *x86_64_bounce_buffer = NULL;
-static nat x86_64_bb_next_off;
-
-static void*
-x86_64_high_symbol( char *lbl, void *addr )
-{
-    x86_64_bounce *bounce;
-
-    if ( x86_64_bounce_buffer == NULL || 
-        x86_64_bb_next_off >= X86_64_BB_SIZE ) {
-       x86_64_bounce_buffer = 
-           mmap(NULL, X86_64_BB_SIZE * sizeof(x86_64_bounce), 
-                PROT_EXEC|PROT_READ|PROT_WRITE, 
-                MAP_PRIVATE|MAP_32BIT|MAP_ANONYMOUS, -1, 0);
-       if (x86_64_bounce_buffer == MAP_FAILED) {
-           barf("x86_64_high_symbol: mmap failed");
-       }
-       x86_64_bb_next_off = 0;
-    }
-    bounce = &x86_64_bounce_buffer[x86_64_bb_next_off];
-    bounce->jmp[0] = 0xff;
-    bounce->jmp[1] = 0x25;
-    bounce->jmp[2] = 0x02;
-    bounce->jmp[3] = 0x00;
-    bounce->jmp[4] = 0x00;
-    bounce->jmp[5] = 0x00;
-    bounce->addr = addr;
-    x86_64_bb_next_off++;
-
-    IF_DEBUG(linker, debugBelch("x86_64: allocated bounce entry for %s->%p at %p\n",
-                               lbl, addr, bounce));
-
-    insertStrHashTable(symhash, lbl, bounce);
-    return bounce;
-}
-#endif
-
-
 /*
  * Generic ELF functions
  */
@@ -2829,9 +2893,12 @@ ocVerifyImage_ELF ( ObjectCode* oc )
       case EM_PPC:   IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
 #ifdef EM_X86_64
       case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
+#elif defined(EM_AMD64)
+      case EM_AMD64: IF_DEBUG(linker,debugBelch( "amd64" )); break;
 #endif
       default:       IF_DEBUG(linker,debugBelch( "unknown" ));
-                     errorBelch("%s: unknown architecture", oc->fileName);
+                     errorBelch("%s: unknown architecture (e_machine == %d)"
+                                , oc->fileName, ehdr->e_machine);
                      return 0;
    }
 
@@ -3413,12 +3480,13 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 
             if( delta << 6 >> 6 != delta )
             {
-               value = makeJumpIsland( oc, ELF_R_SYM(info), value );
+               value = (Elf_Addr) (&makeSymbolExtra( oc, ELF_R_SYM(info), value )
+                                        ->jumpIsland);
                delta = value - P;
 
                if( value == 0 || delta << 6 >> 6 != delta )
                {
-                  barf( "Unable to make ppcJumpIsland for #%d",
+                  barf( "Unable to make SymbolExtra for #%d",
                         ELF_R_SYM(info) );
                   return 0;
                }
@@ -3438,28 +3506,73 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
       {
          StgInt64 off = value - P;
          if (off >= 0x7fffffffL || off < -0x80000000L) {
-             barf("R_X86_64_PC32 relocation out of range: %s = %p",
-                  symbol, off);
-         }
+#if X86_64_ELF_NONPIC_HACK
+             StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
+                                                -> jumpIsland;
+              off = pltAddress + A - P;
+#else
+              barf("R_X86_64_PC32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
+                   symbol, off, oc->fileName );
+#endif
+          }
+         *(Elf64_Word *)P = (Elf64_Word)off;
+         break;
+      }
+
+      case R_X86_64_PC64:
+      {
+         StgInt64 off = value - P;
          *(Elf64_Word *)P = (Elf64_Word)off;
          break;
       }
 
       case R_X86_64_32:
          if (value >= 0x7fffffffL) {
-             barf("R_X86_64_32 relocation out of range: %s = %p\n",
-                  symbol, value);
-         }
+#if X86_64_ELF_NONPIC_HACK           
+              StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
+                                                -> jumpIsland;
+              value = pltAddress + A;
+#else
+              barf("R_X86_64_32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
+                  symbol, value, oc->fileName );
+#endif
+          }
          *(Elf64_Word *)P = (Elf64_Word)value;
          break;
 
       case R_X86_64_32S:
          if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
-             barf("R_X86_64_32S relocation out of range: %s = %p\n",
-                  symbol, value);
+#if X86_64_ELF_NONPIC_HACK           
+              StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
+                                                -> jumpIsland;
+              value = pltAddress + A;
+#else
+              barf("R_X86_64_32S relocation out of range: %s = %p\nRecompile %s with -fPIC.",
+                  symbol, value, oc->fileName );
+#endif
          }
          *(Elf64_Sword *)P = (Elf64_Sword)value;
          break;
+         
+      case R_X86_64_GOTPCREL:
+      {
+          StgInt64 gotAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)->addr;
+         StgInt64 off = gotAddress + A - P;
+         *(Elf64_Word *)P = (Elf64_Word)off;
+         break;
+      }
+      
+      case R_X86_64_PLT32:
+      {
+         StgInt64 off = value - P;
+         if (off >= 0x7fffffffL || off < -0x80000000L) {
+              StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
+                                                    -> jumpIsland;
+              off = pltAddress + A - P;
+         }
+         *(Elf64_Word *)P = (Elf64_Word)off;
+         break;
+      }
 #endif
 
          default:
@@ -3612,12 +3725,12 @@ ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
 #endif /* ia64 */
 
 /*
- * PowerPC ELF specifics
+ * PowerPC & X86_64 ELF specifics
  */
 
-#ifdef powerpc_HOST_ARCH
+#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
 
-static int ocAllocateJumpIslands_ELF( ObjectCode *oc )
+static int ocAllocateSymbolExtras_ELF( ObjectCode *oc )
 {
   Elf_Ehdr *ehdr;
   Elf_Shdr* shdr;
@@ -3639,12 +3752,12 @@ static int ocAllocateJumpIslands_ELF( ObjectCode *oc )
   if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
   {
     errorBelch( "The entry size (%d) of the symtab isn't %d\n",
-      shdr[i].sh_entsize, sizeof( Elf_Sym ) );
+      (int) shdr[i].sh_entsize, (int) sizeof( Elf_Sym ) );
     
     return 0;
   }
 
-  return ocAllocateJumpIslands( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
+  return ocAllocateSymbolExtras( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
 }
 
 #endif /* powerpc */
@@ -3667,8 +3780,15 @@ static int ocAllocateJumpIslands_ELF( ObjectCode *oc )
   *) add still more sanity checks.
 */
 
+#if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
+#define mach_header mach_header_64
+#define segment_command segment_command_64
+#define section section_64
+#define nlist nlist_64
+#endif
+
 #ifdef powerpc_HOST_ARCH
-static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
+static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
 {
     struct mach_header *header = (struct mach_header *) oc->image;
     struct load_command *lc = (struct load_command *) (header + 1);
@@ -3703,20 +3823,52 @@ static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
                 }
             }
             if(max >= min)
-                return ocAllocateJumpIslands(oc, max - min + 1, min);
+                return ocAllocateSymbolExtras(oc, max - min + 1, min);
 
             break;
         }
         
         lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
     }
-    return ocAllocateJumpIslands(oc,0,0);
+    return ocAllocateSymbolExtras(oc,0,0);
+}
+#endif
+#ifdef x86_64_HOST_ARCH
+static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
+{
+    struct mach_header *header = (struct mach_header *) oc->image;
+    struct load_command *lc = (struct load_command *) (header + 1);
+    unsigned i;
+
+    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;
 }
 
@@ -3825,6 +3977,109 @@ static int relocateSection(
 
     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 =
@@ -4022,8 +4277,12 @@ static int relocateSection(
 #ifdef powerpc_HOST_ARCH
                             // In the .o file, this should be a relative jump to NULL
                             // and we'll change it to a relative jump to the symbol
-                        ASSERT(-word == reloc->r_address);
-                        jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,(unsigned long) symbolAddress);
+                        ASSERT(word + reloc->r_address == 0);
+                        jumpIsland = (unsigned long)
+                                        &makeSymbolExtra(oc,
+                                                         reloc->r_symbolnum,
+                                                         (unsigned long) symbolAddress)
+                                         -> jumpIsland;
                         if(jumpIsland != 0)
                         {
                             offsetToJumpIsland = word + jumpIsland
@@ -4086,6 +4345,7 @@ static int relocateSection(
            barf("\nunknown relocation %d",reloc->r_type);
            return 0;
        }
+#endif
     }
     return 1;
 }
@@ -4106,7 +4366,7 @@ static int ocGetNames_MachO(ObjectCode* oc)
 
     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;
@@ -4116,6 +4376,9 @@ static int ocGetNames_MachO(ObjectCode* oc)
     sections = (struct section*) (segLC+1);
     nlist = symLC ? (struct nlist*) (image + symLC->symoff)
                   : NULL;
+    
+    if(!segLC)
+        barf("ocGetNames_MachO: no segment load command");
 
     for(i=0;i<segLC->nsects;i++)
     {
@@ -4186,21 +4449,17 @@ static int ocGetNames_MachO(ObjectCode* oc)
                 if(nlist[i].n_type & N_EXT)
                 {
                     char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
-                    ghciInsertStrHashTable(oc->fileName, symhash, nm,
-                                            image
-                                            + sections[nlist[i].n_sect-1].offset
-                                            - sections[nlist[i].n_sect-1].addr
-                                            + nlist[i].n_value);
-                    oc->symbols[curSymbol++] = nm;
-                }
-                else
-                {
-                    char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
-                    ghciInsertStrHashTable(oc->fileName, oc->lochash, nm,
-                                            image
-                                            + sections[nlist[i].n_sect-1].offset
-                                            - sections[nlist[i].n_sect-1].addr
-                                            + nlist[i].n_value);
+                    if((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm))
+                        ; // weak definition, and we already have a definition
+                    else
+                    {
+                            ghciInsertStrHashTable(oc->fileName, symhash, nm,
+                                                    image
+                                                    + sections[nlist[i].n_sect-1].offset
+                                                    - sections[nlist[i].n_sect-1].addr
+                                                    + nlist[i].n_value);
+                            oc->symbols[curSymbol++] = nm;
+                    }
                 }
             }
         }
@@ -4245,7 +4504,7 @@ static int ocResolve_MachO(ObjectCode* oc)
 
     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;
@@ -4349,9 +4608,14 @@ static int machoGetMisalignment( FILE * f )
     fread(&header, sizeof(header), 1, f);
     rewind(f);
 
+#if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
+    if(header.magic != MH_MAGIC_64)
+        return 0;
+#else
     if(header.magic != MH_MAGIC)
         return 0;
-    
+#endif
+
     misalignment = (header.sizeofcmds + sizeof(header))
                     & 0xF;
 
@@ -4359,3 +4623,4 @@ static int machoGetMisalignment( FILE * f )
 }
 
 #endif
+