Merge commit with origin/master
[ghc.git] / rts / Linker.c
index 92194df..9a7c300 100644 (file)
@@ -27,8 +27,9 @@
 #include "RtsUtils.h"
 #include "Trace.h"
 #include "StgPrimFloat.h" // for __int_encodeFloat etc.
-#include "Stable.h"
 #include "Proftimer.h"
+#include "GetEnv.h"
+#include "Stable.h"
 
 #if !defined(mingw32_HOST_OS)
 #include "posix/Signals.h"
@@ -46,6 +47,7 @@
 #include <string.h>
 #include <stdio.h>
 #include <assert.h>
+#include <libgen.h>
 
 #ifdef HAVE_SYS_STAT_H
 #include <sys/stat.h>
 #include <sys/tls.h>
 #endif
 
-// Defining this as 'int' rather than 'const int' means that we don't get
-// warnings like
-//    error: function might be possible candidate for attribute ‘noreturn’
-// from gcc:
-#ifdef DYNAMIC_GHC_PROGRAMS
-int dynamicGhcPrograms = 1;
-#else
-int dynamicGhcPrograms = 0;
-#endif
+typedef struct _RtsSymbolInfo {
+    void *value;
+    const ObjectCode *owner;
+    HsBool weak;
+} RtsSymbolInfo;
 
-/* Hash table mapping symbol names to Symbol */
+/* Hash table mapping symbol names to RtsSymbolInfo */
 static /*Str*/HashTable *symhash;
 
-/* Hash table mapping symbol names to StgStablePtr */
-static /*Str*/HashTable *stablehash;
-
 /* List of currently loaded objects */
 ObjectCode *objects = NULL;     /* initially empty */
 
+/* List of objects that have been unloaded via unloadObj(), but are waiting
+   to be actually freed via checkUnload() */
+ObjectCode *unloaded_objects = NULL; /* initially empty */
+
+/* Type of the initializer */
+typedef void (*init_t) (int argc, char **argv, char **env);
+
+static HsInt isAlreadyLoaded( pathchar *path );
 static HsInt loadOc( ObjectCode* oc );
 static ObjectCode* mkOc( pathchar *path, char *image, int imageSize,
                          char *archiveMemberName
@@ -175,7 +178,6 @@ static ObjectCode* mkOc( pathchar *path, char *image, int imageSize,
 #define struct_stat struct _stat
 #define open wopen
 #define WSTR(s) L##s
-#define PATH_FMT "S"
 #else
 #define pathcmp strcmp
 #define pathlen strlen
@@ -183,7 +185,6 @@ static ObjectCode* mkOc( pathchar *path, char *image, int imageSize,
 #define pathstat stat
 #define struct_stat struct stat
 #define WSTR(s) s
-#define PATH_FMT "s"
 #endif
 
 static pathchar* pathdup(pathchar *path)
@@ -204,6 +205,7 @@ static pathchar* pathdup(pathchar *path)
 static int ocVerifyImage_ELF    ( ObjectCode* oc );
 static int ocGetNames_ELF       ( ObjectCode* oc );
 static int ocResolve_ELF        ( ObjectCode* oc );
+static int ocRunInit_ELF        ( ObjectCode* oc );
 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) || defined(arm_HOST_ARCH)
 static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc );
 #endif
@@ -211,12 +213,26 @@ static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc );
 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
 static int ocGetNames_PEi386    ( ObjectCode* oc );
 static int ocResolve_PEi386     ( ObjectCode* oc );
+static int ocRunInit_PEi386     ( ObjectCode* oc );
 static void *lookupSymbolInDLLs ( unsigned char *lbl );
 static void zapTrailingAtSign   ( unsigned char *sym );
+static char *allocateImageAndTrampolines (
+#if defined(x86_64_HOST_ARCH)
+   FILE* f, pathchar* arch_name, char* member_name,
+#endif
+   int size );
+#if defined(x86_64_HOST_ARCH)
+static int ocAllocateSymbolExtras_PEi386 ( ObjectCode* oc );
+static size_t makeSymbolExtra_PEi386( ObjectCode* oc, size_t, char* symbol );
+#define PEi386_IMAGE_OFFSET 4
+#else
+#define PEi386_IMAGE_OFFSET 0
+#endif
 #elif defined(OBJFORMAT_MACHO)
 static int ocVerifyImage_MachO    ( ObjectCode* oc );
 static int ocGetNames_MachO       ( ObjectCode* oc );
 static int ocResolve_MachO        ( ObjectCode* oc );
+static int ocRunInit_MachO        ( ObjectCode* oc );
 
 #ifndef USE_MMAP
 static int machoGetMisalignment( FILE * );
@@ -229,6 +245,8 @@ static void machoInitSymbolsWithoutUnderscore( void );
 #endif
 #endif
 
+static void freeProddableBlocks (ObjectCode *oc);
+
 /* 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
@@ -842,6 +860,7 @@ typedef struct _RtsSymbolVal {
 #if !defined(mingw32_HOST_OS)
 #define RTS_USER_SIGNALS_SYMBOLS        \
    SymI_HasProto(setIOManagerControlFd) \
+   SymI_HasProto(setTimerManagerControlFd) \
    SymI_HasProto(setIOManagerWakeupFd)  \
    SymI_HasProto(ioManagerWakeup)       \
    SymI_HasProto(blockUserSignals)      \
@@ -882,6 +901,8 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_ap_d_ret)                       \
       SymI_HasProto(stg_ap_l_ret)                       \
       SymI_HasProto(stg_ap_v16_ret)                     \
+      SymI_HasProto(stg_ap_v32_ret)                     \
+      SymI_HasProto(stg_ap_v64_ret)                     \
       SymI_HasProto(stg_ap_n_ret)                       \
       SymI_HasProto(stg_ap_p_ret)                       \
       SymI_HasProto(stg_ap_pv_ret)                      \
@@ -960,7 +981,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(UPD_PAP_IN_PLACE_ctr)               \
       SymI_HasProto(ALLOC_HEAP_ctr)                     \
       SymI_HasProto(ALLOC_HEAP_tot)                     \
-      SymI_HasProto(HEAP_CHK_ctr)                      \
+      SymI_HasProto(HEAP_CHK_ctr)                       \
       SymI_HasProto(STK_CHK_ctr)                        \
       SymI_HasProto(ALLOC_RTS_ctr)                      \
       SymI_HasProto(ALLOC_RTS_tot)                      \
@@ -1072,6 +1093,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(__word_encodeFloat)                                 \
       SymI_HasProto(stg_atomicallyzh)                                   \
       SymI_HasProto(barf)                                               \
+      SymI_HasProto(deRefStablePtr)                                     \
       SymI_HasProto(debugBelch)                                         \
       SymI_HasProto(errorBelch)                                         \
       SymI_HasProto(sysErrorBelch)                                      \
@@ -1086,6 +1108,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(cmp_thread)                                         \
       SymI_HasProto(createAdjustor)                                     \
       SymI_HasProto(stg_decodeDoublezu2Intzh)                           \
+      SymI_HasProto(stg_decodeDoublezuInt64zh)                          \
       SymI_HasProto(stg_decodeFloatzuIntzh)                             \
       SymI_HasProto(defaultsHook)                                       \
       SymI_HasProto(stg_delayzh)                                        \
@@ -1113,6 +1136,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(getProgArgv)                                        \
       SymI_HasProto(getFullProgArgv)                                    \
       SymI_HasProto(getStablePtr)                                       \
+      SymI_HasProto(foreignExportStablePtr)                             \
       SymI_HasProto(hs_init)                                            \
       SymI_HasProto(hs_exit)                                            \
       SymI_HasProto(hs_set_argv)                                        \
@@ -1126,6 +1150,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(hs_hpc_rootModule)                                  \
       SymI_HasProto(hs_hpc_module)                                      \
       SymI_HasProto(initLinker)                                         \
+      SymI_HasProto(initLinker_)                                        \
       SymI_HasProto(stg_unpackClosurezh)                                \
       SymI_HasProto(stg_getApStackValzh)                                \
       SymI_HasProto(stg_getSparkzh)                                     \
@@ -1135,7 +1160,6 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_killThreadzh)                                   \
       SymI_HasProto(loadArchive)                                        \
       SymI_HasProto(loadObj)                                            \
-      SymI_HasProto(insertStableSymbol)                                 \
       SymI_HasProto(insertSymbol)                                       \
       SymI_HasProto(lookupSymbol)                                       \
       SymI_HasProto(stg_makeStablePtrzh)                                \
@@ -1143,13 +1167,28 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_myThreadIdzh)                                   \
       SymI_HasProto(stg_labelThreadzh)                                  \
       SymI_HasProto(stg_newArrayzh)                                     \
+      SymI_HasProto(stg_copyArrayzh)                                    \
+      SymI_HasProto(stg_copyMutableArrayzh)                             \
+      SymI_HasProto(stg_copyArrayArrayzh)                               \
+      SymI_HasProto(stg_copyMutableArrayArrayzh)                        \
+      SymI_HasProto(stg_cloneArrayzh)                                   \
+      SymI_HasProto(stg_cloneMutableArrayzh)                            \
+      SymI_HasProto(stg_freezzeArrayzh)                                 \
+      SymI_HasProto(stg_thawArrayzh)                                    \
       SymI_HasProto(stg_newArrayArrayzh)                                \
       SymI_HasProto(stg_casArrayzh)                                     \
+      SymI_HasProto(stg_newSmallArrayzh)                                \
+      SymI_HasProto(stg_unsafeThawSmallArrayzh)                         \
+      SymI_HasProto(stg_cloneSmallArrayzh)                              \
+      SymI_HasProto(stg_cloneSmallMutableArrayzh)                       \
+      SymI_HasProto(stg_freezzeSmallArrayzh)                            \
+      SymI_HasProto(stg_thawSmallArrayzh)                               \
+      SymI_HasProto(stg_copySmallArrayzh)                               \
+      SymI_HasProto(stg_copySmallMutableArrayzh)                        \
+      SymI_HasProto(stg_casSmallArrayzh)                                \
       SymI_HasProto(stg_newBCOzh)                                       \
       SymI_HasProto(stg_newByteArrayzh)                                 \
       SymI_HasProto(stg_casIntArrayzh)                                  \
-      SymI_HasProto(stg_fetchAddIntArrayzh)                             \
-      SymI_HasProto_redirect(newCAF, newDynCAF)                         \
       SymI_HasProto(stg_newMVarzh)                                      \
       SymI_HasProto(stg_newMutVarzh)                                    \
       SymI_HasProto(stg_newTVarzh)                                      \
@@ -1158,6 +1197,8 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_casMutVarzh)                                    \
       SymI_HasProto(stg_newPinnedByteArrayzh)                           \
       SymI_HasProto(stg_newAlignedPinnedByteArrayzh)                    \
+      SymI_HasProto(stg_shrinkMutableByteArrayzh)                       \
+      SymI_HasProto(stg_resizzeMutableByteArrayzh)                      \
       SymI_HasProto(newSpark)                                           \
       SymI_HasProto(performGC)                                          \
       SymI_HasProto(performMajorGC)                                     \
@@ -1221,6 +1262,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(rts_unsafeGetMyCapability)                          \
       SymI_HasProto(rtsSupportsBoundThreads)                            \
       SymI_HasProto(rts_isProfiled)                                     \
+      SymI_HasProto(rts_isDynamic)                                      \
       SymI_HasProto(setProgArgv)                                        \
       SymI_HasProto(startupHaskell)                                     \
       SymI_HasProto(shutdownHaskell)                                    \
@@ -1243,12 +1285,19 @@ typedef struct _RtsSymbolVal {
       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_SMALL_MUT_ARR_PTRS_DIRTY_info)                  \
+      SymI_HasProto(stg_SMALL_MUT_ARR_PTRS_FROZEN_info)                 \
+      SymI_HasProto(stg_SMALL_MUT_ARR_PTRS_FROZEN0_info)                \
+      SymI_HasProto(stg_MUT_VAR_CLEAN_info)                             \
+      SymI_HasProto(stg_MUT_VAR_DIRTY_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_v16_info)                                    \
+      SymI_HasProto(stg_ap_v32_info)                                    \
+      SymI_HasProto(stg_ap_v64_info)                                    \
       SymI_HasProto(stg_ap_n_info)                                      \
       SymI_HasProto(stg_ap_p_info)                                      \
       SymI_HasProto(stg_ap_pv_info)                                     \
@@ -1265,6 +1314,8 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_ap_d_fast)                                      \
       SymI_HasProto(stg_ap_l_fast)                                      \
       SymI_HasProto(stg_ap_v16_fast)                                    \
+      SymI_HasProto(stg_ap_v32_fast)                                    \
+      SymI_HasProto(stg_ap_v64_fast)                                    \
       SymI_HasProto(stg_ap_n_fast)                                      \
       SymI_HasProto(stg_ap_p_fast)                                      \
       SymI_HasProto(stg_ap_pv_fast)                                     \
@@ -1337,6 +1388,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(g0)                                                 \
       SymI_HasProto(allocate)                                           \
       SymI_HasProto(allocateExec)                                       \
+      SymI_HasProto(flushExec)                                          \
       SymI_HasProto(freeExec)                                           \
       SymI_HasProto(getAllocations)                                     \
       SymI_HasProto(revertCAFs)                                         \
@@ -1355,6 +1407,8 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(unlockFile)                                         \
       SymI_HasProto(startProfTimer)                                     \
       SymI_HasProto(stopProfTimer)                                      \
+      SymI_HasProto(atomic_inc)                                         \
+      SymI_HasProto(atomic_dec)                                         \
       RTS_USER_SIGNALS_SYMBOLS                                          \
       RTS_INTCHAR_SYMBOLS
 
@@ -1454,22 +1508,42 @@ static RtsSymbolVal rtsSyms[] = {
 
 /* -----------------------------------------------------------------------------
  * Insert symbols into hash tables, checking for duplicates.
+ *
+ * Returns: 0 on failure, nonzero on success
  */
 
-static void ghciInsertStrHashTable ( pathchar* obj_name,
-                                     HashTable *table,
-                                     char* key,
-                                     void *data
-                                   )
+static int ghciInsertSymbolTable(
+   pathchar* obj_name,
+   HashTable *table,
+   char* key,
+   void *data,
+   HsBool weak,
+   ObjectCode *owner)
 {
-   if (lookupHashTable(table, (StgWord)key) == NULL)
+   RtsSymbolInfo *pinfo = lookupStrHashTable(table, key);
+   if (!pinfo) /* new entry */
    {
-      insertStrHashTable(table, (StgWord)key, data);
-      return;
+      pinfo = stgMallocBytes(sizeof (*pinfo), "ghciInsertToSymbolTable");
+      pinfo->value = data;
+      pinfo->owner = owner;
+      pinfo->weak = weak;
+      insertStrHashTable(table, key, pinfo);
+      return 1;
+   }
+   else if ((!pinfo->weak || pinfo->value) && weak)
+   {
+     return 1; /* duplicate weak symbol, throw it away */
+   }
+   else if (pinfo->weak) /* weak symbol is in the table */
+   {
+      /* override the weak definition with the non-weak one */
+      pinfo->value = data;
+      pinfo->owner = owner;
+      pinfo->weak = HS_BOOL_FALSE;
+      return 1;
    }
    debugBelch(
-      "\n\n"
-      "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
+      "GHC runtime linker: fatal error: I found a duplicate definition for symbol\n"
       "   %s\n"
       "whilst processing object file\n"
       "   %" PATH_FMT "\n"
@@ -1477,13 +1551,37 @@ static void ghciInsertStrHashTable ( pathchar* obj_name,
       "   * Loading two different object files which export the same symbol\n"
       "   * Specifying the same object file twice on the GHCi command line\n"
       "   * An incorrect `package.conf' entry, causing some object to be\n"
-      "     loaded twice.\n"
-      "GHCi cannot safely continue in this situation.  Exiting now.  Sorry.\n"
-      "\n",
+      "     loaded twice.\n",
       (char*)key,
       obj_name
    );
-   stg_exit(1);
+   return 0;
+}
+
+static HsBool ghciLookupSymbolTable(HashTable *table,
+    const char *key, void **result)
+{
+    RtsSymbolInfo *pinfo = lookupStrHashTable(table, key);
+    if (!pinfo) {
+        *result = NULL;
+        return HS_BOOL_FALSE;
+    }
+    if (pinfo->weak)
+        IF_DEBUG(linker, debugBelch("lookup: promoting %s\n", key));
+    /* Once it's looked up, it can no longer be overridden */
+    pinfo->weak = HS_BOOL_FALSE;
+
+    *result = pinfo->value;
+    return HS_BOOL_TRUE;
+}
+
+static void ghciRemoveSymbolTable(HashTable *table, const char *key,
+    ObjectCode *owner)
+{
+    RtsSymbolInfo *pinfo = lookupStrHashTable(table, key);
+    if (!pinfo || owner != pinfo->owner) return;
+    removeStrHashTable(table, key, NULL);
+    stgFree(pinfo);
 }
 /* -----------------------------------------------------------------------------
  * initialize the object linker
@@ -1499,10 +1597,20 @@ static regex_t re_realso;
 #ifdef THREADED_RTS
 static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
 #endif
+#elif defined(OBJFORMAT_PEi386)
+void addDLLHandle(pathchar* dll_name, HINSTANCE instance);
 #endif
 
+void initLinker (void)
+{
+    // default to retaining CAFs for backwards compatibility.  Most
+    // users will want initLinker_(0): otherwise unloadObj() will not
+    // be able to unload object files when they contain CAFs.
+    initLinker_(1);
+}
+
 void
-initLinker( void )
+initLinker_ (int retain_cafs)
 {
     RtsSymbolVal *sym;
 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
@@ -1521,21 +1629,42 @@ initLinker( void )
         linker_init_done = 1;
     }
 
+    objects = NULL;
+    unloaded_objects = NULL;
+
 #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(WSTR("(GHCi built-in symbols)"),
-                               symhash, sym->lbl, sym->addr);
+        if (! ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"),
+                                    symhash, sym->lbl, sym->addr, HS_BOOL_FALSE, NULL)) {
+            barf("ghciInsertSymbolTable failed");
+        }
         IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr));
     }
 #   if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
     machoInitSymbolsWithoutUnderscore();
 #   endif
+    /* GCC defines a special symbol __dso_handle which is resolved to NULL if
+       referenced from a statically linked module. We need to mimic this, but
+       we cannot use NULL because we use it to mean nonexistent symbols. So we
+       use an arbitrary (hopefully unique) address here.
+    */
+    if (! ghciInsertSymbolTable(WSTR("(GHCi special symbols)"),
+                                symhash, "__dso_handle", (void *)0x12345687, HS_BOOL_FALSE, NULL)) {
+        barf("ghciInsertSymbolTable failed");
+    }
+
+    // Redurect newCAF to newDynCAF if retain_cafs is true.
+    if (! ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"), symhash,
+                                MAYBE_LEADING_UNDERSCORE_STR("newCAF"),
+                                retain_cafs ? newDynCAF : newCAF,
+                                HS_BOOL_FALSE, NULL)) {
+        barf("ghciInsertSymbolTable failed");
+    }
 
 #   if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
 #   if defined(RTLD_DEFAULT)
@@ -1573,6 +1702,7 @@ initLinker( void )
      */
     addDLL(WSTR("msvcrt"));
     addDLL(WSTR("kernel32"));
+    addDLLHandle(WSTR("*.exe"), GetModuleHandle(NULL));
 #endif
 
     IF_DEBUG(linker, debugBelch("initLinker: done\n"));
@@ -1590,6 +1720,9 @@ exitLinker( void ) {
 #endif
    }
 #endif
+   if (linker_init_done == 1) {
+       freeHashTable(symhash, free);
+   }
 }
 
 /* -----------------------------------------------------------------------------
@@ -1625,6 +1758,28 @@ typedef
 
 /* A list thereof. */
 static OpenedDLL* opened_dlls = NULL;
+
+/* A record for storing indirectly linked functions from DLLs. */
+typedef
+   struct _IndirectAddr {
+      void*                 addr;
+      struct _IndirectAddr* next;
+   }
+   IndirectAddr;
+
+/* A list thereof. */
+static IndirectAddr* indirects = NULL;
+
+/* Adds a DLL instance to the list of DLLs in which to search for symbols. */
+void addDLLHandle(pathchar* dll_name, HINSTANCE instance) {
+   OpenedDLL* o_dll;
+   o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLLHandle" );
+   o_dll->name     = dll_name ? pathdup(dll_name) : NULL;
+   o_dll->instance = instance;
+   o_dll->next     = opened_dlls;
+   opened_dlls     = o_dll;
+}
+
 #endif
 
 #  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
@@ -1708,7 +1863,7 @@ internal_dlsym(void *hdl, const char *symbol) {
             return v;
         }
     }
-    v = dlsym(hdl, symbol)
+    v = dlsym(hdl, symbol);
     RELEASE_LOCK(&dl_mutex);
     return v;
 }
@@ -1773,6 +1928,7 @@ addDLL( pathchar *dll_name )
             // success -- try to dlopen the first named file
             IF_DEBUG(linker, debugBelch("match%s\n",""));
             line[match[2].rm_eo] = '\0';
+            stgFree((void*)errmsg); // Free old message before creating new one
             errmsg = internal_dlopen(line+match[2].rm_so);
             break;
          }
@@ -1831,12 +1987,7 @@ addDLL( pathchar *dll_name )
    }
    stgFree(buf);
 
-   /* Add this DLL to the list of DLLs in which to search for symbols. */
-   o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
-   o_dll->name     = pathdup(dll_name);
-   o_dll->instance = instance;
-   o_dll->next     = opened_dlls;
-   opened_dlls     = o_dll;
+   addDLLHandle(dll_name, instance);
 
    return NULL;
 
@@ -1853,23 +2004,13 @@ error:
 }
 
 /* -----------------------------------------------------------------------------
- * insert a stable symbol in the hash table
- */
-
-void
-insertStableSymbol(pathchar* obj_name, char* key, StgPtr p)
-{
-  ghciInsertStrHashTable(obj_name, stablehash, key, getStablePtr(p));
-}
-
-
-/* -----------------------------------------------------------------------------
  * insert a symbol in the hash table
+ *
+ * Returns: 0 on failure, nozero on success
  */
-void
-insertSymbol(pathchar* obj_name, char* key, void* data)
+HsInt insertSymbol(pathchar* obj_name, char* key, void* data)
 {
-  ghciInsertStrHashTable(obj_name, symhash, key, data);
+    return ghciInsertSymbolTable(obj_name, symhash, key, data, HS_BOOL_FALSE, NULL);
 }
 
 /* -----------------------------------------------------------------------------
@@ -1882,9 +2023,8 @@ lookupSymbol( char *lbl )
     IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl));
     initLinker() ;
     ASSERT(symhash != NULL);
-    val = lookupStrHashTable(symhash, lbl);
 
-    if (val == NULL) {
+    if (!ghciLookupSymbolTable(symhash, lbl, &val)) {
         IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n"));
 #       if defined(OBJFORMAT_ELF)
         return internal_dlsym(dl_prog_handle, lbl);
@@ -1896,12 +2036,12 @@ lookupSymbol( char *lbl )
            HACK: On OS X, all symbols are prefixed with an underscore.
                  However, dlsym wants us to omit the leading underscore from the
                  symbol name -- the dlsym routine puts it back on before searching
-                for the symbol. For now, we simply strip it off here (and ONLY
+                 for the symbol. 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 internal_dlsym(dl_prog_handle, lbl + 1);
+        ASSERT(lbl[0] == '_');
+        return internal_dlsym(dl_prog_handle, lbl + 1);
 #       else
         if (NSIsSymbolNameDefined(lbl)) {
             NSSymbol symbol = NSLookupAndBindSymbol(lbl);
@@ -1934,6 +2074,37 @@ lookupSymbol( char *lbl )
 }
 
 /* -----------------------------------------------------------------------------
+   Create a StablePtr for a foreign export.  This is normally called by
+   a C function with __attribute__((constructor)), which is generated
+   by GHC and linked into the module.
+
+   If the object code is being loaded dynamically, then we remember
+   which StablePtrs were allocated by the constructors and free them
+   again in unloadObj().
+   -------------------------------------------------------------------------- */
+
+static ObjectCode *loading_obj = NULL;
+
+StgStablePtr foreignExportStablePtr (StgPtr p)
+{
+    ForeignExportStablePtr *fe_sptr;
+    StgStablePtr *sptr;
+
+    sptr = getStablePtr(p);
+
+    if (loading_obj != NULL) {
+        fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr),
+                                 "foreignExportStablePtr");
+        fe_sptr->stable_ptr = sptr;
+        fe_sptr->next = loading_obj->stable_ptrs;
+        loading_obj->stable_ptrs = fe_sptr;
+    }
+
+    return sptr;
+}
+
+
+/* -----------------------------------------------------------------------------
  * Debugging aid: look in GHCi's object symbol tables for symbols
  * within DELTA bytes of the specified address, and show their names.
  */
@@ -1956,7 +2127,7 @@ void ghci_enquire ( char* addr )
          if (sym == NULL) continue;
          a = NULL;
          if (a == NULL) {
-            a = lookupStrHashTable(symhash, sym);
+            ghciLookupSymbolTable(symhash, sym, (void **)&a);
          }
          if (a == NULL) {
              // debugBelch("ghci_enquire: can't find %s\n", sym);
@@ -1972,12 +2143,15 @@ void ghci_enquire ( char* addr )
 #ifdef USE_MMAP
 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
 
-static void *
-mmapForLinker (size_t bytes, nat flags, int fd)
+//
+// Returns NULL on failure.
+//
+static void * mmapForLinker (size_t bytes, nat flags, int fd)
 {
    void *map_addr = NULL;
    void *result;
-   int pagesize, size;
+   int pagesize;
+   StgWord size;
    static nat fixed = 0;
 
    IF_DEBUG(linker, debugBelch("mmapForLinker: start\n"));
@@ -1992,15 +2166,21 @@ mmap_again:
    }
 #endif
 
-   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);
+   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);
 
    if (result == MAP_FAILED) {
        sysErrorBelch("mmap %" FMT_Word " bytes at %p",(W_)size,map_addr);
        errorBelch("Try specifying an address with +RTS -xm<addr> -RTS");
-       stg_exit(EXIT_FAILURE);
+       return NULL;
    }
 
 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
@@ -2010,15 +2190,21 @@ mmap_again:
        } 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)
+               munmap(result,size);
+#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);
+               errorBelch("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);
+               return NULL;
 #endif
            } else {
                // hmm, we were given memory somewhere else, but it's
@@ -2031,7 +2217,9 @@ mmap_again:
        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);
+           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)
@@ -2041,12 +2229,105 @@ mmap_again:
    }
 #endif
 
-   IF_DEBUG(linker, debugBelch("mmapForLinker: mapped %" FMT_Word " bytes starting at %p\n", (W_)size, result));
-   IF_DEBUG(linker, debugBelch("mmapForLinker: done\n"));
+   IF_DEBUG(linker,
+            debugBelch("mmapForLinker: mapped %" FMT_Word
+                       " bytes starting at %p\n", (W_)size, result));
+   IF_DEBUG(linker,
+            debugBelch("mmapForLinker: done\n"));
+
    return result;
 }
 #endif // USE_MMAP
 
+static void removeOcSymbols (ObjectCode *oc)
+{
+    if (oc->symbols == NULL) return;
+
+    /* 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) {
+            ghciRemoveSymbolTable(symhash, oc->symbols[i], oc);
+        }
+    }
+}
+
+/*
+ * freeObjectCode() releases all the pieces of an ObjectCode.  It is called by
+ * the GC when a previously unloaded ObjectCode has been determined to be
+ * unused, and when an error occurs during loadObj().
+ */
+void freeObjectCode (ObjectCode *oc)
+{
+    if (oc->symbols != NULL) {
+        stgFree(oc->symbols);
+        oc->symbols = NULL;
+    }
+
+    {
+        Section *s, *nexts;
+
+        for (s = oc->sections; s != NULL; s = nexts) {
+            nexts = s->next;
+            stgFree(s);
+        }
+    }
+
+    freeProddableBlocks(oc);
+
+#ifdef USE_MMAP
+    int pagesize, size, r;
+
+    pagesize = getpagesize();
+    size = ROUND_UP(oc->fileSize, pagesize);
+
+    r = munmap(oc->image, size);
+    if (r == -1) {
+        sysErrorBelch("munmap");
+    }
+
+#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) || defined(arm_HOST_ARCH)
+#if !defined(x86_64_HOST_ARCH) || !defined(mingw32_HOST_OS)
+    if (!USE_CONTIGUOUS_MMAP && oc->symbol_extras != NULL)
+    {
+        munmap(oc->symbol_extras,
+               ROUND_UP(sizeof(SymbolExtra) * oc->n_symbol_extras, pagesize));
+    }
+#endif
+#endif
+
+#else
+
+#ifndef mingw32_HOST_OS
+    stgFree(oc->image);
+#else
+    VirtualFree(oc->image - PEi386_IMAGE_OFFSET, 0, MEM_RELEASE);
+
+    IndirectAddr *ia, *ia_next;
+    ia = indirects;
+    while (ia != NULL) {
+      ia_next = ia->next;
+      stgFree(ia);
+      ia = ia_next;
+    }
+
+#endif
+
+#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) || defined(arm_HOST_ARCH)
+#if !defined(x86_64_HOST_ARCH) || !defined(mingw32_HOST_OS)
+    stgFree(oc->symbol_extras);
+#endif
+#endif
+
+#endif
+
+    stgFree(oc->fileName);
+    stgFree(oc->archiveMemberName);
+    stgFree(oc);
+}
+
+
 static ObjectCode*
 mkOc( pathchar *path, char *image, int imageSize,
       char *archiveMemberName
@@ -2059,7 +2340,7 @@ mkOc( pathchar *path, char *image, int imageSize,
    ObjectCode* oc;
 
    IF_DEBUG(linker, debugBelch("mkOc: start\n"));
-   oc = stgMallocBytes(sizeof(ObjectCode), "loadArchive(oc)");
+   oc = stgMallocBytes(sizeof(ObjectCode), "mkOc(oc)");
 
 #  if defined(OBJFORMAT_ELF)
    oc->formatName = "ELF";
@@ -2087,6 +2368,10 @@ mkOc( pathchar *path, char *image, int imageSize,
    oc->symbols           = NULL;
    oc->sections          = NULL;
    oc->proddables        = NULL;
+   oc->stable_ptrs       = NULL;
+#if powerpc_HOST_ARCH || x86_64_HOST_ARCH || arm_HOST_ARCH
+   oc->symbol_extras     = NULL;
+#endif
 
 #ifndef USE_MMAP
 #ifdef darwin_HOST_OS
@@ -2095,13 +2380,29 @@ mkOc( pathchar *path, char *image, int imageSize,
 #endif
 
    /* chain it onto the list of objects */
-   oc->next              = objects;
-   objects               = oc;
+   oc->next              = NULL;
 
    IF_DEBUG(linker, debugBelch("mkOc: done\n"));
    return oc;
 }
 
+/* -----------------------------------------------------------------------------
+ * Check if an object or archive is already loaded.
+ *
+ * Returns: 1 if the path is already loaded, 0 otherwise.
+ */
+static HsInt
+isAlreadyLoaded( pathchar *path )
+{
+    ObjectCode *o;
+    for (o = objects; o; o = o->next) {
+       if (0 == pathcmp(o->fileName, path)) {
+           return 1; /* already loaded */
+       }
+    }
+    return 0; /* not loaded yet */
+}
+
 HsInt
 loadArchive( pathchar *path )
 {
@@ -2113,7 +2414,7 @@ loadArchive( pathchar *path )
     size_t thisFileNameSize;
     char *fileName;
     size_t fileNameSize;
-    int isObject, isGnuIndex;
+    int isObject, isGnuIndex, isThin;
     char tmp[20];
     char *gnuFileIndex;
     int gnuFileIndexSize;
@@ -2140,11 +2441,21 @@ loadArchive( pathchar *path )
 #endif
 #endif
 
+    /* TODO: don't call barf() on error, instead return an error code, freeing
+     * all resources correctly.  This function is pretty complex, so it needs
+     * to be refactored to make this practical. */
+
+    initLinker();
+
     IF_DEBUG(linker, debugBelch("loadArchive: start\n"));
     IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%" PATH_FMT" '\n", path));
 
-    if (dynamicGhcPrograms) {
-        barf("loadArchive called, but using dynamic GHC (%s)", path);
+    /* Check that we haven't already loaded this archive.
+       Ignore requests to load multiple times */
+    if (isAlreadyLoaded(path)) {
+        IF_DEBUG(linker,
+                 debugBelch("ignoring repeated load of %" PATH_FMT "\n", path));
+        return 1; /* success */
     }
 
     gnuFileIndex = NULL;
@@ -2153,6 +2464,8 @@ loadArchive( pathchar *path )
     fileNameSize = 32;
     fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)");
 
+    isThin = 0;
+
     f = pathopen(path, WSTR("rb"));
     if (!f)
         barf("loadObj: can't read `%s'", path);
@@ -2179,53 +2492,58 @@ loadArchive( pathchar *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) {
-
+    if (strncmp(tmp, "!<arch>\n", 8) == 0) {}
+#if !defined(mingw32_HOST_OS)
+    /* See Note [thin archives on Windows] */
+    else if (strncmp(tmp, "!<thin>\n", 8) == 0) {
+        isThin = 1;
+    }
+#endif
 #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;
-                }
+    /* Not a standard archive, look for a fat archive magic number: */
+    else 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;
             }
+        }
 
-            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);
-                }
-            }
+        if (nfat_offset == 0) {
+           barf ("loadArchive: searched %d architectures, but no host arch found", (int)nfat_arch);
         }
         else {
-            barf("loadArchive: Neither an archive, nor a fat archive: `%s'", path);
+            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);
+    }
 #else
+    else {
         barf("loadArchive: Not an archive: `%s'", path);
-#endif
     }
+#endif
 
     IF_DEBUG(linker, debugBelch("loadArchive: loading archive contents\n"));
 
@@ -2331,8 +2649,8 @@ loadArchive( pathchar *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;
+                for (i = n; gnuFileIndex[i] != '\n'; i++);
+                thisFileNameSize = i - n - 1;
                 if (thisFileNameSize >= fileNameSize) {
                     /* Double it to avoid potentially continually
                        increasing it by 1 */
@@ -2407,23 +2725,11 @@ loadArchive( pathchar *path )
 #elif defined(mingw32_HOST_OS)
         // TODO: We would like to use allocateExec here, but allocateExec
         //       cannot currently allocate blocks large enough.
-            {
-                int offset;
+            image = allocateImageAndTrampolines(
 #if defined(x86_64_HOST_ARCH)
-                /* We get back 8-byte aligned memory (is that guaranteed?), but
-                   the offsets to the sections within the file are all 4 mod 8
-                   (is that guaranteed?). We therefore need to offset the image
-                   by 4, so that all the pointers are 8-byte aligned, so that
-                   pointer tagging works. */
-                offset = 4;
-#else
-                offset = 0;
+               f, path, fileName,
 #endif
-                image = VirtualAlloc(NULL, memberSize + offset,
-                                     MEM_RESERVE | MEM_COMMIT,
-                                     PAGE_EXECUTE_READWRITE);
-                image += offset;
-            }
+               memberSize);
 #elif defined(darwin_HOST_OS)
             /* See loadObj() */
             misalignment = machoGetMisalignment(f);
@@ -2432,9 +2738,53 @@ loadArchive( pathchar *path )
 #else
             image = stgMallocBytes(memberSize, "loadArchive(image)");
 #endif
-            n = fread ( image, 1, memberSize, f );
-            if (n != memberSize) {
-                barf("loadArchive: error whilst reading `%s'", path);
+
+#if !defined(mingw32_HOST_OS)
+            /*
+             * Note [thin archives on Windows]
+             * This doesn't compile on Windows because it assumes
+             * char* pathnames, and we use wchar_t* on Windows.  It's
+             * not trivial to fix, so I'm leaving it disabled on
+             * Windows for now --SDM
+             */
+            if (isThin) {
+                FILE *member;
+                char *pathCopy, *dirName, *memberPath;
+
+                /* Allocate and setup the dirname of the archive.  We'll need
+                   this to locate the thin member */
+                pathCopy = stgMallocBytes(strlen(path) + 1, "loadArchive(file)");
+                strcpy(pathCopy, path);
+                dirName = dirname(pathCopy);
+
+                /* Append the relative member name to the dirname.  This should be
+                   be the full path to the actual thin member. */
+                memberPath = stgMallocBytes(
+                    strlen(path) + 1 + strlen(fileName) + 1, "loadArchive(file)");
+                strcpy(memberPath, dirName);
+                memberPath[strlen(dirName)] = '/';
+                strcpy(memberPath + strlen(dirName) + 1, fileName);
+
+                member = pathopen(memberPath, WSTR("rb"));
+                if (!member)
+                    barf("loadObj: can't read `%s'", path);
+
+                n = fread ( image, 1, memberSize, member );
+                if (n != memberSize) {
+                    barf("loadArchive: error whilst reading `%s'", fileName);
+                }
+
+                fclose(member);
+                stgFree(memberPath);
+                stgFree(pathCopy);
+            }
+            else
+#endif
+            {
+                n = fread ( image, 1, memberSize, f );
+                if (n != memberSize) {
+                    barf("loadArchive: error whilst reading `%s'", path);
+                }
             }
 
             archiveMemberName = stgMallocBytes(pathlen(path) + thisFileNameSize + 3,
@@ -2454,7 +2804,11 @@ loadArchive( pathchar *path )
 
             if (0 == loadOc(oc)) {
                 stgFree(fileName);
+                fclose(f);
                 return 0;
+            } else {
+                oc->next = objects;
+                objects = oc;
             }
         }
         else if (isGnuIndex) {
@@ -2476,14 +2830,16 @@ loadArchive( pathchar *path )
         }
         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);
+            if (!isThin || thisFileNameSize == 0) {
+                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 (!(isThin && thisFileNameSize > 0) && memberSize % 2) {
             IF_DEBUG(linker, debugBelch("loadArchive: trying to read one pad byte\n"));
             n = fread ( tmp, 1, 1, f );
             if (n != 1) {
@@ -2538,34 +2894,17 @@ loadObj( pathchar *path )
 #endif
    IF_DEBUG(linker, debugBelch("loadObj %" PATH_FMT "\n", path));
 
-   if (dynamicGhcPrograms) {
-       barf("loadObj called, but using dynamic GHC (%s)", 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 == pathcmp(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"
-            "   %" PATH_FMT "\n"
-            "GHCi will ignore this, but be warned.\n"
-            , path));
-          return 1; /* success */
-       }
+
+   if (isAlreadyLoaded(path)) {
+       IF_DEBUG(linker,
+                debugBelch("ignoring repeated load of %" PATH_FMT "\n", path));
+       return 1; /* success */
    }
 
    r = pathstat(path, &st);
@@ -2580,41 +2919,41 @@ loadObj( pathchar *path )
    /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
 
 #if defined(openbsd_HOST_OS)
+   /* coverity[toctou] */
    fd = open(path, O_RDONLY, S_IRUSR);
 #else
+   /* coverity[toctou] */
    fd = open(path, O_RDONLY);
 #endif
-   if (fd == -1)
-      barf("loadObj: can't open `%s'", path);
+   if (fd == -1) {
+      errorBelch("loadObj: can't open `%s'", path);
+      return 0;
+   }
 
    image = mmapForLinker(fileSize, 0, fd);
-
    close(fd);
+   if (image == NULL) return 0;
 
 #else /* !USE_MMAP */
    /* load the image into memory */
+   /* coverity[toctou] */
    f = pathopen(path, WSTR("rb"));
-   if (!f)
-       barf("loadObj: can't read `%" PATH_FMT "'", path);
+   if (!f) {
+       errorBelch("loadObj: can't read `%" PATH_FMT "'", path);
+       return 0;
+   }
 
 #   if defined(mingw32_HOST_OS)
         // TODO: We would like to use allocateExec here, but allocateExec
         //       cannot currently allocate blocks large enough.
-    {
-        int offset;
+    image = allocateImageAndTrampolines(
 #if defined(x86_64_HOST_ARCH)
-        /* We get back 8-byte aligned memory (is that guaranteed?), but
-           the offsets to the sections within the file are all 4 mod 8
-           (is that guaranteed?). We therefore need to offset the image
-           by 4, so that all the pointers are 8-byte aligned, so that
-           pointer tagging works. */
-        offset = 4;
-#else
-        offset = 0;
+       f, path, "itself",
 #endif
-      image = VirtualAlloc(NULL, fileSize + offset, MEM_RESERVE | MEM_COMMIT,
-                           PAGE_EXECUTE_READWRITE);
-      image += offset;
+       fileSize);
+    if (image == NULL) {
+        fclose(f);
+        return 0;
     }
 #   elif defined(darwin_HOST_OS)
     // In a Mach-O .o file, all sections can and will be misaligned
@@ -2636,10 +2975,13 @@ loadObj( pathchar *path )
    {
        int n;
        n = fread ( image, 1, fileSize, f );
-       if (n != fileSize)
-           barf("loadObj: error whilst reading `%s'", path);
+       fclose(f);
+       if (n != fileSize) {
+           errorBelch("loadObj: error whilst reading `%" PATH_FMT "'", path);
+           stgFree(image);
+           return 0;
+       }
    }
-   fclose(f);
 #endif /* USE_MMAP */
 
    oc = mkOc(path, image, fileSize, NULL
@@ -2650,7 +2992,16 @@ loadObj( pathchar *path )
 #endif
             );
 
-   return loadOc(oc);
+   if (! loadOc(oc)) {
+       // failed; free everything we've allocated
+       removeOcSymbols(oc);
+       freeObjectCode(oc);
+       return 0;
+   }
+
+   oc->next = objects;
+   objects = oc;
+   return 1;
 }
 
 static HsInt
@@ -2659,20 +3010,6 @@ loadOc( ObjectCode* oc ) {
 
    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) || defined(arm_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 */
 #  if defined(OBJFORMAT_ELF)
    r = ocVerifyImage_ELF ( oc );
@@ -2688,6 +3025,22 @@ loadOc( ObjectCode* oc ) {
        return r;
    }
 
+#  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) || defined(arm_HOST_ARCH))
+   r = ocAllocateSymbolExtras_ELF ( oc );
+   if (!r) {
+       IF_DEBUG(linker, debugBelch("loadOc: ocAllocateSymbolExtras_ELF failed\n"));
+       return r;
+   }
+#  elif defined(OBJFORMAT_PEi386) && defined(x86_64_HOST_ARCH)
+   ocAllocateSymbolExtras_PEi386 ( oc );
+#endif
+
    /* build the symbol list for this image */
 #  if defined(OBJFORMAT_ELF)
    r = ocGetNames_ELF ( oc );
@@ -2736,6 +3089,23 @@ resolveObjs( void )
             barf("resolveObjs: not implemented on this platform");
 #           endif
             if (!r) { return r; }
+
+            // run init/init_array/ctors/mod_init_func
+
+            loading_obj = oc; // tells foreignExportStablePtr what to do
+#if defined(OBJFORMAT_ELF)
+            r = ocRunInit_ELF ( oc );
+#elif defined(OBJFORMAT_PEi386)
+            r = ocRunInit_PEi386 ( oc );
+#elif defined(OBJFORMAT_MACHO)
+            r = ocRunInit_MachO ( oc );
+#else
+            barf("resolveObjs: initializers not implemented on this platform");
+#endif
+            loading_obj = NULL;
+
+            if (!r) { return r; }
+
             oc->status = OBJECT_RESOLVED;
         }
     }
@@ -2749,7 +3119,7 @@ resolveObjs( void )
 HsInt
 unloadObj( pathchar *path )
 {
-    ObjectCode *oc, *prev;
+    ObjectCode *oc, *prev, *next;
     HsBool unloadedAnyObj = HS_BOOL_FALSE;
 
     ASSERT(symhash != NULL);
@@ -2757,47 +3127,43 @@ unloadObj( pathchar *path )
 
     initLinker();
 
+    IF_DEBUG(linker, debugBelch("unloadObj: %" PATH_FMT "\n", path));
+
     prev = NULL;
-    for (oc = objects; oc; prev = oc, oc = oc->next) {
+    for (oc = objects; oc; oc = next) {
+        next = oc->next; // oc might be freed
+
         if (!pathcmp(oc->fileName,path)) {
 
-            /* 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) {
-                       removeStrHashTable(symhash, oc->symbols[i], NULL);
-                   }
-                }
-            }
+            removeOcSymbols(oc);
 
             if (prev == NULL) {
                 objects = oc->next;
             } else {
                 prev->next = oc->next;
             }
+            oc->next = unloaded_objects;
+            unloaded_objects = oc;
 
-            // We're going to leave this in place, in case there are
-            // any pointers from the heap into it:
-                // #ifdef mingw32_HOST_OS
-                // If uncommenting, note that currently oc->image is
-                // not the right address to free on Win64, as we added
-                // 4 bytes of padding at the start
-                //  VirtualFree(oc->image);
-                // #else
-            //  stgFree(oc->image);
-            // #endif
-            stgFree(oc->fileName);
-            stgFree(oc->archiveMemberName);
-            stgFree(oc->symbols);
-            stgFree(oc->sections);
-            stgFree(oc);
+            // Release any StablePtrs that were created when this
+            // object module was initialized.
+            {
+                ForeignExportStablePtr *fe_ptr, *next;
+
+                for (fe_ptr = oc->stable_ptrs; fe_ptr != NULL; fe_ptr = next) {
+                    next = fe_ptr->next;
+                    freeStablePtr(fe_ptr->stable_ptr);
+                    stgFree(fe_ptr);
+                }
+            }
+
+            oc->status = OBJECT_UNLOADED;
 
             /* This could be a member of an archive so continue
              * unloading other members. */
             unloadedAnyObj = HS_BOOL_TRUE;
+        } else {
+            prev = oc;
         }
     }
 
@@ -2843,6 +3209,17 @@ checkProddableBlock (ObjectCode *oc, void *addr, size_t size )
    barf("checkProddableBlock: invalid fixup in runtime linker: %p", addr);
 }
 
+static void freeProddableBlocks (ObjectCode *oc)
+{
+    ProddableBlock *pb, *next;
+
+    for (pb = oc->proddables; pb != NULL; pb = next) {
+        next = pb->next;
+        stgFree(pb);
+    }
+    oc->proddables = NULL;
+}
+
 /* -----------------------------------------------------------------------------
  * Section management.
  */
@@ -2931,15 +3308,19 @@ static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
                 memcpy(new, oc->image, oc->fileSize);
                 munmap(oc->image, n);
                 oc->image = new;
+                oc->fileSize = n + (sizeof(SymbolExtra) * count);
                 oc->symbol_extras = (SymbolExtra *) (oc->image + n);
             }
-            else
+            else {
                 oc->symbol_extras = NULL;
+                return 0;
+            }
         }
         else
         {
             oc->symbol_extras = mmapForLinker(sizeof(SymbolExtra) * count,
                                           MAP_ANONYMOUS, -1);
+            if (oc->symbol_extras == NULL) return 0;
         }
     }
     else
@@ -3275,6 +3656,63 @@ typedef
 #define MYIMAGE_REL_I386_DIR32           0x0006
 #define MYIMAGE_REL_I386_REL32           0x0014
 
+static int verifyCOFFHeader ( COFF_header *hdr, pathchar *filename);
+
+/* We assume file pointer is right at the
+   beginning of COFF object.
+ */
+static char *
+allocateImageAndTrampolines (
+#if defined(x86_64_HOST_ARCH)
+   FILE* f, pathchar* arch_name, char* member_name,
+#endif
+   int size )
+{
+   char* image;
+#if defined(x86_64_HOST_ARCH)
+   /* PeCoff contains number of symbols right in it's header, so
+      we can reserve the room for symbolExtras right here. */
+   COFF_header hdr;
+   size_t n;
+
+   n = fread ( &hdr, 1, sizeof_COFF_header, f );
+   if (n != sizeof( COFF_header )) {
+       errorBelch("getNumberOfSymbols: error whilst reading `%s' header in `%S'",
+                  member_name, arch_name);
+       return NULL;
+   }
+   fseek( f, -sizeof_COFF_header, SEEK_CUR );
+
+   if (!verifyCOFFHeader(&hdr, arch_name)) {
+       return 0;
+   }
+
+   /* We get back 8-byte aligned memory (is that guaranteed?), but
+      the offsets to the sections within the file are all 4 mod 8
+      (is that guaranteed?). We therefore need to offset the image
+      by 4, so that all the pointers are 8-byte aligned, so that
+      pointer tagging works. */
+   /* For 32-bit case we don't need this, hence we use macro PEi386_IMAGE_OFFSET,
+      which equals to 4 for 64-bit case and 0 for 32-bit case. */
+   /* We allocate trampolines area for all symbols right behind
+      image data, aligned on 8. */
+   size = ((PEi386_IMAGE_OFFSET + size + 0x7) & ~0x7)
+              + hdr.NumberOfSymbols * sizeof(SymbolExtra);
+#endif
+   image = VirtualAlloc(NULL, size,
+                        MEM_RESERVE | MEM_COMMIT,
+                        PAGE_EXECUTE_READWRITE);
+
+   if (image == NULL) {
+/*       errorBelch("%" PATH_FMT ": failed to allocate memory for image",
+                  arch_name);
+*/
+       errorBelch( "Failed to allocate memory for image (windows)" );
+       return NULL;
+   }
+
+   return image + PEi386_IMAGE_OFFSET;
+}
 
 /* We use myindex to calculate array addresses, rather than
    simply doing the normal subscript thing.  That's because
@@ -3383,9 +3821,10 @@ cstring_from_section_name (UChar* name, UChar* strtab)
 
 /* Just compares the short names (first 8 chars) */
 static COFF_section *
-findPEi386SectionCalled ( ObjectCode* oc,  UChar* name )
+findPEi386SectionCalled ( ObjectCode* oc,  UChar* name, UChar* strtab )
 {
    int i;
+   rtsBool long_name = rtsFalse;
    COFF_header* hdr
       = (COFF_header*)(oc->image);
    COFF_section* sectab
@@ -3393,6 +3832,14 @@ findPEi386SectionCalled ( ObjectCode* oc,  UChar* name )
            ((UChar*)(oc->image))
            + sizeof_COFF_header + hdr->SizeOfOptionalHeader
         );
+   // String is longer than 8 bytes, swap in the proper
+   // (NULL-terminated) version, and make a note that this
+   // is a long name.
+   if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
+      UInt32 strtab_offset = * (UInt32*)(name+4);
+      name = ((UChar*)strtab) + strtab_offset;
+      long_name = rtsTrue;
+   }
    for (i = 0; i < hdr->NumberOfSections; i++) {
       UChar* n1;
       UChar* n2;
@@ -3401,10 +3848,28 @@ findPEi386SectionCalled ( ObjectCode* oc,  UChar* name )
            myindex ( sizeof_COFF_section, sectab, i );
       n1 = (UChar*) &(section_i->Name);
       n2 = name;
-      if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
-          n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
-          n1[6]==n2[6] && n1[7]==n2[7])
-         return section_i;
+      // Long section names are prefixed with a slash, see
+      // also cstring_from_section_name
+      if (n1[0] == '/' && long_name) {
+         // Long name check
+         // We don't really want to make an assumption that the string
+         // table indexes are the same, so we'll do a proper check.
+         int n1_strtab_offset = strtol((char*)n1+1,NULL,10);
+         n1 = (UChar*) (((char*)strtab) + n1_strtab_offset);
+         if (0==strcmp((const char*)n1, (const char*)n2)) {
+            return section_i;
+         }
+      } else if (n1[0] != '/' && !long_name) {
+         // Short name check
+         if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
+             n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
+             n1[6]==n2[6] && n1[7]==n2[7]) {
+            return section_i;
+         }
+      } else {
+         // guaranteed to mismatch, because we never attempt to link
+         // in an executable where the section name may be truncated
+      }
    }
 
    return NULL;
@@ -3446,6 +3911,28 @@ lookupSymbolInDLLs ( UChar *lbl )
                 return sym;
             }
         }
+
+        /* Ticket #2283.
+           Long description: http://support.microsoft.com/kb/132044
+           tl;dr:
+             If C/C++ compiler sees __declspec(dllimport) ... foo ...
+             it generates call *__imp_foo, and __imp_foo here has exactly
+             the same semantics as in __imp_foo = GetProcAddress(..., "foo")
+         */
+        if (sym == NULL && strncmp ((const char*)lbl, "__imp_", 6) == 0) {
+            sym = GetProcAddress(o_dll->instance, (char*)(lbl+6));
+            if (sym != NULL) {
+                IndirectAddr* ret;
+                ret = stgMallocBytes( sizeof(IndirectAddr), "lookupSymbolInDLLs" );
+                ret->addr = sym;
+                ret->next = indirects;
+                indirects = ret;
+                errorBelch("warning: %s from %S is linked instead of %s",
+                              (char*)(lbl+6), o_dll->name, (char*)lbl);
+                return (void*) & ret->addr;
+               }
+        }
+
         sym = GetProcAddress(o_dll->instance, (char*)lbl);
         if (sym != NULL) {
             /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
@@ -3455,37 +3942,17 @@ lookupSymbolInDLLs ( UChar *lbl )
     return NULL;
 }
 
-
 static int
-ocVerifyImage_PEi386 ( ObjectCode* oc )
+verifyCOFFHeader (COFF_header *hdr, pathchar *fileName)
 {
-   int i;
-   UInt32 j, noRelocs;
-   COFF_header*  hdr;
-   COFF_section* sectab;
-   COFF_symbol*  symtab;
-   UChar*        strtab;
-   /* debugBelch("\nLOADING %s\n", oc->fileName); */
-   hdr = (COFF_header*)(oc->image);
-   sectab = (COFF_section*) (
-               ((UChar*)(oc->image))
-               + sizeof_COFF_header + hdr->SizeOfOptionalHeader
-            );
-   symtab = (COFF_symbol*) (
-               ((UChar*)(oc->image))
-               + hdr->PointerToSymbolTable
-            );
-   strtab = ((UChar*)symtab)
-            + hdr->NumberOfSymbols * sizeof_COFF_symbol;
-
 #if defined(i386_HOST_ARCH)
    if (hdr->Machine != 0x14c) {
-      errorBelch("%" PATH_FMT ": Not x86 PEi386", oc->fileName);
+      errorBelch("%" PATH_FMT ": Not x86 PEi386", fileName);
       return 0;
    }
 #elif defined(x86_64_HOST_ARCH)
    if (hdr->Machine != 0x8664) {
-      errorBelch("%" PATH_FMT ": Not x86_64 PEi386", oc->fileName);
+      errorBelch("%" PATH_FMT ": Not x86_64 PEi386", fileName);
       return 0;
    }
 #else
@@ -3493,23 +3960,53 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
 #endif
 
    if (hdr->SizeOfOptionalHeader != 0) {
-      errorBelch("%" PATH_FMT ": PEi386 with nonempty optional header", oc->fileName);
+      errorBelch("%" PATH_FMT ": PEi386 with nonempty optional header",
+                 fileName);
       return 0;
    }
    if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
         (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
         (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
         (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
-      errorBelch("%" PATH_FMT ": Not a PEi386 object file", oc->fileName);
+      errorBelch("%" PATH_FMT ": Not a PEi386 object file", fileName);
       return 0;
    }
    if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
         /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
       errorBelch("%" PATH_FMT ": Invalid PEi386 word size or endiannness: %d",
-                 oc->fileName,
+                 fileName,
                  (int)(hdr->Characteristics));
       return 0;
    }
+   return 1;
+}
+
+static int
+ocVerifyImage_PEi386 ( ObjectCode* oc )
+{
+   int i;
+   UInt32 j, noRelocs;
+   COFF_header*  hdr;
+   COFF_section* sectab;
+   COFF_symbol*  symtab;
+   UChar*        strtab;
+   /* debugBelch("\nLOADING %s\n", oc->fileName); */
+   hdr = (COFF_header*)(oc->image);
+   sectab = (COFF_section*) (
+               ((UChar*)(oc->image))
+               + sizeof_COFF_header + hdr->SizeOfOptionalHeader
+            );
+   symtab = (COFF_symbol*) (
+               ((UChar*)(oc->image))
+               + hdr->PointerToSymbolTable
+            );
+   strtab = ((UChar*)symtab)
+            + hdr->NumberOfSymbols * sizeof_COFF_symbol;
+
+   if (!verifyCOFFHeader(hdr, oc->fileName)) {
+       return 0;
+   }
+
    /* If the string table size is way crazy, this might indicate that
       there are more than 64k relocations, despite claims to the
       contrary.  Hence this test. */
@@ -3710,7 +4207,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
        * => I suspect we've been incorrectly handling .bss sections in (relocatable)
        * object files up until now. This turned out to bite us with ghc-6.4.1's use
        * of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
-       * variable decls into to the .bss section. (The specific function in Q which
+       * variable decls into the .bss section. (The specific function in Q which
        * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
        */
       if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
@@ -3746,6 +4243,11 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       /* I'm sure this is the Right Way to do it.  However, the
          alternative of testing the sectab_i->Name field seems to
          work ok with Cygwin.
+
+         EZY: We should strongly consider using this style, because
+         it lets us pick up sections that should be added (e.g.
+         for a while the linker did not work due to missing .eh_frame
+         in this section.)
       */
       if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
           sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
@@ -3754,12 +4256,16 @@ ocGetNames_PEi386 ( ObjectCode* oc )
 
       if (0==strcmp(".text",(char*)secname) ||
           0==strcmp(".text.startup",(char*)secname) ||
+          0==strcmp(".text.unlikely", (char*)secname) ||
           0==strcmp(".rdata",(char*)secname)||
+          0==strcmp(".eh_frame", (char*)secname)||
           0==strcmp(".rodata",(char*)secname))
          kind = SECTIONKIND_CODE_OR_RODATA;
       if (0==strcmp(".data",(char*)secname) ||
           0==strcmp(".bss",(char*)secname))
          kind = SECTIONKIND_RWDATA;
+      if (0==strcmp(".ctors", (char*)secname))
+         kind = SECTIONKIND_INIT_ARRAY;
 
       ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
       sz = sectab_i->SizeOfRawData;
@@ -3774,15 +4280,15 @@ ocGetNames_PEi386 ( ObjectCode* oc )
           && 0 != strcmp(".stab", (char*)secname)
           && 0 != strcmp(".stabstr", (char*)secname)
           /* Ignore sections called which contain exception information. */
-          && 0 != strcmp(".pdata", (char*)secname)
-          && 0 != strcmp(".xdata", (char*)secname)
-          /* ignore constructor section for now */
-          && 0 != strcmp(".ctors", (char*)secname)
+          && 0 != strncmp(".pdata", (char*)secname, 6)
+          && 0 != strncmp(".xdata", (char*)secname, 6)
           /* ignore section generated from .ident */
           && 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)
+          /* ignore linker directive sections */
+          && 0 != strcmp(".drectve", (char*)secname)
          ) {
          errorBelch("Unknown PEi386 section name `%s' (while processing: %" PATH_FMT")", secname, oc->fileName);
          stgFree(secname);
@@ -3790,8 +4296,10 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       }
 
       if (kind != SECTIONKIND_OTHER && end >= start) {
-          if ((((size_t)(start)) % sizeof(void *)) != 0) {
-              barf("Misaligned section: %p", start);
+          if ((((size_t)(start)) % 4) != 0) {
+              errorBelch("Misaligned section %s: %p", (char*)secname, start);
+              stgFree(secname);
+              return 0;
           }
 
          addSection(oc, kind, start, end);
@@ -3855,7 +4363,10 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          ASSERT(i >= 0 && i < oc->n_symbols);
          /* cstring_from_COFF_symbol_name always succeeds. */
          oc->symbols[i] = (char*)sname;
-         ghciInsertStrHashTable(oc->fileName, symhash, (char*)sname, addr);
+         if (! ghciInsertSymbolTable(oc->fileName, symhash, (char*)sname, addr,
+                                     HS_BOOL_FALSE, oc)) {
+             return 0;
+         }
       } else {
 #        if 0
          debugBelch(
@@ -3887,6 +4398,46 @@ ocGetNames_PEi386 ( ObjectCode* oc )
    return 1;
 }
 
+#if defined(x86_64_HOST_ARCH)
+
+/* We've already reserved a room for symbol extras in loadObj,
+ * so simply set correct pointer here.
+ */
+static int
+ocAllocateSymbolExtras_PEi386 ( ObjectCode* oc )
+{
+   oc->symbol_extras = (SymbolExtra*)(oc->image - PEi386_IMAGE_OFFSET
+                                      + ((PEi386_IMAGE_OFFSET + oc->fileSize + 0x7) & ~0x7));
+   oc->first_symbol_extra = 0;
+   oc->n_symbol_extras = ((COFF_header*)oc->image)->NumberOfSymbols;
+
+   return 1;
+}
+
+static size_t
+makeSymbolExtra_PEi386( ObjectCode* oc, size_t s, char* symbol )
+{
+    unsigned int curr_thunk;
+    SymbolExtra *extra;
+
+    curr_thunk = oc->first_symbol_extra;
+    if (curr_thunk >= oc->n_symbol_extras) {
+      barf("Can't allocate thunk for %s", symbol);
+    }
+
+    extra = oc->symbol_extras + curr_thunk;
+
+    // jmp *-14(%rip)
+    static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
+    extra->addr = (uint64_t)s;
+    memcpy(extra->jumpIsland, jmp, 6);
+
+    oc->first_symbol_extra++;
+
+    return (size_t)extra->jumpIsland;
+}
+
+#endif
 
 static int
 ocResolve_PEi386 ( ObjectCode* oc )
@@ -3936,9 +4487,8 @@ ocResolve_PEi386 ( ObjectCode* oc )
          information. */
       if (0 == strcmp(".stab", (char*)secname)
           || 0 == strcmp(".stabstr", (char*)secname)
-          || 0 == strcmp(".pdata", (char*)secname)
-          || 0 == strcmp(".xdata", (char*)secname)
-          || 0 == strcmp(".ctors", (char*)secname)
+          || 0 == strncmp(".pdata", (char*)secname, 6)
+          || 0 == strncmp(".xdata", (char*)secname, 6)
           || 0 == strncmp(".debug", (char*)secname, 6)
           || 0 == strcmp(".rdata$zzz", (char*)secname)) {
           stgFree(secname);
@@ -4006,9 +4556,11 @@ ocResolve_PEi386 ( ObjectCode* oc )
 
          if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
             COFF_section* section_sym
-               = findPEi386SectionCalled ( oc, sym->Name );
+               = findPEi386SectionCalled ( oc, sym->Name, strtab );
             if (!section_sym) {
-               errorBelch("%" PATH_FMT ": can't find section `%s'", oc->fileName, sym->Name);
+               errorBelch("%" PATH_FMT ": can't find section named: ", oc->fileName);
+               printName(sym->Name, strtab);
+               errorBelch(" in %s", secname);
                return 0;
             }
             S = ((size_t)(oc->image))
@@ -4065,8 +4617,13 @@ ocResolve_PEi386 ( ObjectCode* oc )
                    v = S + ((size_t)A);
                    if (v >> 32) {
                        copyName ( sym->Name, strtab, symbol, 1000-1 );
-                       barf("R_X86_64_32[S]: High bits are set in %zx for %s",
-                            v, (char *)symbol);
+                       S = makeSymbolExtra_PEi386(oc, S, (char *)symbol);
+                       /* And retry */
+                       v = S + ((size_t)A);
+                       if (v >> 32) {
+                           barf("R_X86_64_32[S]: High bits are set in %zx for %s",
+                                v, (char *)symbol);
+                       }
                    }
                    *(UInt32 *)pP = (UInt32)v;
                    break;
@@ -4076,9 +4633,15 @@ ocResolve_PEi386 ( ObjectCode* oc )
                    intptr_t v;
                    v = ((intptr_t)S) + ((intptr_t)(Int32)A) - ((intptr_t)pP) - 4;
                    if ((v >> 32) && ((-v) >> 32)) {
+                       /* Make the trampoline then */
                        copyName ( sym->Name, strtab, symbol, 1000-1 );
-                       barf("R_X86_64_PC32: High bits are set in %zx for %s",
-                            v, (char *)symbol);
+                       S = makeSymbolExtra_PEi386(oc, S, (char *)symbol);
+                       /* And retry */
+                       v = ((intptr_t)S) + ((intptr_t)(Int32)A) - ((intptr_t)pP) - 4;
+                       if ((v >> 32) && ((-v) >> 32)) {
+                           barf("R_X86_64_PC32: High bits are set in %zx for %s",
+                                v, (char *)symbol);
+                       }
                    }
                    *(UInt32 *)pP = (UInt32)v;
                    break;
@@ -4105,6 +4668,49 @@ ocResolve_PEi386 ( ObjectCode* oc )
    return 1;
 }
 
+static int
+ocRunInit_PEi386 ( ObjectCode *oc )
+{
+    COFF_header*  hdr;
+    COFF_section* sectab;
+    UChar*        strtab;
+    int i;
+
+    hdr = (COFF_header*)(oc->image);
+    sectab = (COFF_section*) (
+                ((UChar*)(oc->image))
+                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
+             );
+    strtab = ((UChar*)(oc->image))
+             + hdr->PointerToSymbolTable
+             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
+
+    int argc, envc;
+    char **argv, **envv;
+
+    getProgArgv(&argc, &argv);
+    getProgEnvv(&envc, &envv);
+
+    for (i = 0; i < hdr->NumberOfSections; i++) {
+        COFF_section* sectab_i
+            = (COFF_section*)
+                myindex ( sizeof_COFF_section, sectab, i );
+        char *secname = cstring_from_section_name(sectab_i->Name, strtab);
+        if (0 == strcmp(".ctors", (char*)secname)) {
+            UChar *init_startC = (UChar*)(oc->image) + sectab_i->PointerToRawData;
+            init_t *init_start, *init_end, *init;
+            init_start = (init_t*)init_startC;
+            init_end = (init_t*)(init_startC + sectab_i->SizeOfRawData);
+            // ctors are run *backwards*!
+            for (init = init_end - 1; init >= init_start; init--) {
+                (*init)(argc, argv, envv);
+            }
+        }
+    }
+    freeProgEnvv(envc, envv);
+    return 1;
+}
+
 #endif /* defined(OBJFORMAT_PEi386) */
 
 
@@ -4581,6 +5187,12 @@ static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
         return SECTIONKIND_CODE_OR_RODATA;
     }
 
+    if (hdr->sh_type == SHT_INIT_ARRAY
+        && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
+       /* .init_array section */
+        return SECTIONKIND_INIT_ARRAY;
+    }
+
     if (hdr->sh_type == SHT_NOBITS
         && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
         /* .bss-style section */
@@ -4640,8 +5252,11 @@ ocGetNames_ELF ( ObjectCode* oc )
       nent = shdr[i].sh_size / sizeof(Elf_Sym);
 
       oc->n_symbols = nent;
-      oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
+      oc->symbols = stgCallocBytes(oc->n_symbols, sizeof(char*),
                                    "ocGetNames_ELF(oc->symbols)");
+      // Note calloc: if we fail partway through initializing symbols, we need
+      // to undo the additions to the symbol table so far. We know which ones
+      // have been added by whether the entry is NULL or not.
 
       //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
@@ -4649,6 +5264,7 @@ ocGetNames_ELF ( ObjectCode* oc )
       for (j = 0; j < nent; j++) {
 
          char  isLocal = FALSE; /* avoids uninit-var warning */
+         HsBool isWeak = HS_BOOL_FALSE;
          char* ad      = NULL;
          char* nm      = strtab + stab[j].st_name;
          int   secno   = stab[j].st_shndx;
@@ -4669,6 +5285,7 @@ ocGetNames_ELF ( ObjectCode* oc )
          else
          if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
                 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
+                || ELF_ST_BIND(stab[j].st_info)==STB_WEAK
               )
               /* and not an undefined symbol */
               && stab[j].st_shndx != SHN_UNDEF
@@ -4692,7 +5309,8 @@ ocGetNames_ELF ( ObjectCode* oc )
             ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
             if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
                isLocal = TRUE;
-            } else {
+               isWeak = FALSE;
+            } else { /* STB_GLOBAL or STB_WEAK */
 #ifdef ELF_FUNCTION_DESC
                /* dlsym() and the initialisation table both give us function
                 * descriptors, so to be consistent we store function descriptors
@@ -4703,6 +5321,7 @@ ocGetNames_ELF ( ObjectCode* oc )
                IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p  %s %s\n",
                                       ad, oc->fileName, nm ));
                isLocal = FALSE;
+               isWeak = (ELF_ST_BIND(stab[j].st_info)==STB_WEAK);
             }
          }
 
@@ -4710,12 +5329,15 @@ ocGetNames_ELF ( ObjectCode* oc )
 
          if (ad != NULL) {
             ASSERT(nm != NULL);
-            oc->symbols[j] = nm;
             /* Acquire! */
             if (isLocal) {
                /* Ignore entirely. */
             } else {
-               ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
+                if (! ghciInsertSymbolTable(oc->fileName, symhash,
+                                            nm, ad, isWeak, oc)) {
+                    return 0;
+                }
+                oc->symbols[j] = nm;
             }
          } else {
             /* Skip. */
@@ -4786,8 +5408,6 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
 #ifdef i386_HOST_ARCH
       Elf_Addr  value;
 #endif
-      StgStablePtr stablePtr;
-      StgPtr stableVal;
 #ifdef arm_HOST_ARCH
       int is_target_thm=0, T=0;
 #endif
@@ -4810,16 +5430,9 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
 
          } else {
             symbol = strtab + sym.st_name;
-            stablePtr = (StgStablePtr)lookupHashTable(stablehash, (StgWord)symbol);
-            if (NULL == stablePtr) {
-              /* No, so look up the name in our global table. */
-              S_tmp = lookupSymbol( symbol );
-              S = (Elf_Addr)S_tmp;
-            } else {
-              stableVal = deRefStablePtr( stablePtr );
-              S_tmp = stableVal;
-              S = (Elf_Addr)S_tmp;
-            }
+            S_tmp = lookupSymbol( symbol );
+            if (S_tmp == NULL) return 0;
+            S = (Elf_Addr)S_tmp;
          }
          if (!S) {
             errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
@@ -5142,7 +5755,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
            errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
            return 0;
          }
-         IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
+         IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
       }
 
       IF_DEBUG(linker,debugBelch("Reloc: P = %p   S = %p   A = %p\n",
@@ -5260,8 +5873,9 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
                                                 -> 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 );
+              errorBelch("R_X86_64_PC32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
+                         symbol, off, oc->fileName );
+              return 0;
 #endif
           }
           *(Elf64_Word *)P = (Elf64_Word)off;
@@ -5286,8 +5900,9 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
                                                 -> jumpIsland;
               value = pltAddress + A;
 #else
-              barf("R_X86_64_32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
-                   symbol, value, oc->fileName );
+              errorBelch("R_X86_64_32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
+                         symbol, value, oc->fileName );
+              return 0;
 #endif
           }
           *(Elf64_Word *)P = (Elf64_Word)value;
@@ -5304,8 +5919,9 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
                                                 -> jumpIsland;
               value = pltAddress + A;
 #else
-              barf("R_X86_64_32S relocation out of range: %s = %p\nRecompile %s with -fPIC.",
-                   symbol, value, oc->fileName );
+              errorBelch("R_X86_64_32S relocation out of range: %s = %p\nRecompile %s with -fPIC.",
+                         symbol, value, oc->fileName );
+              return 0;
 #endif
           }
           *(Elf64_Sword *)P = (Elf64_Sword)value;
@@ -5326,12 +5942,12 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
           barf("R_X86_64_GOTTPOFF relocation, but ALWAYS_PIC.");
 #else
         /* determine the offset of S to the current thread's tls
-           area 
+           area
            XXX: Move this to the beginning of function */
           struct tls_info ti;
           get_tls_area(0, &ti, sizeof(ti));
           /* make entry in GOT that contains said offset */
-          StgInt64 gotEntry = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), 
+          StgInt64 gotEntry = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info),
                                          (S - (Elf64_Addr)(ti.base)))->addr;
           *(Elf64_Word *)P = gotEntry + A - P;
 #endif
@@ -5396,6 +6012,60 @@ ocResolve_ELF ( ObjectCode* oc )
    return 1;
 }
 
+static int ocRunInit_ELF( ObjectCode *oc )
+{
+   int   i;
+   char*     ehdrC = (char*)(oc->image);
+   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;
+   int argc, envc;
+   char **argv, **envv;
+
+   getProgArgv(&argc, &argv);
+   getProgEnvv(&envc, &envv);
+
+   // XXX Apparently in some archs .init may be something
+   // special!  See DL_DT_INIT_ADDRESS macro in glibc
+   // as well as ELF_FUNCTION_PTR_IS_SPECIAL.  We've not handled
+   // it here, please file a bug report if it affects you.
+   for (i = 0; i < ehdr->e_shnum; i++) {
+      init_t *init_start, *init_end, *init;
+      int is_bss = FALSE;
+      SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
+      if (kind == SECTIONKIND_CODE_OR_RODATA
+       && 0 == memcmp(".init", sh_strtab + shdr[i].sh_name, 5)) {
+         init_t init_f = (init_t)(ehdrC + shdr[i].sh_offset);
+         init_f(argc, argv, envv);
+      }
+
+      if (kind == SECTIONKIND_INIT_ARRAY) {
+         char *init_startC = ehdrC + shdr[i].sh_offset;
+         init_start = (init_t*)init_startC;
+         init_end = (init_t*)(init_startC + shdr[i].sh_size);
+         for (init = init_start; init < init_end; init++) {
+            (*init)(argc, argv, envv);
+         }
+      }
+
+      // XXX could be more strict and assert that it's
+      // SECTIONKIND_RWDATA; but allowing RODATA seems harmless enough.
+      if ((kind == SECTIONKIND_RWDATA || kind == SECTIONKIND_CODE_OR_RODATA)
+       && 0 == memcmp(".ctors", sh_strtab + shdr[i].sh_name, 6)) {
+         char *init_startC = ehdrC + shdr[i].sh_offset;
+         init_start = (init_t*)init_startC;
+         init_end = (init_t*)(init_startC + shdr[i].sh_size);
+         // ctors run in reverse
+         for (init = init_end - 1; init >= init_start; init--) {
+            (*init)(argc, argv, envv);
+         }
+      }
+   }
+
+   freeProgEnvv(envc, envv);
+   return 1;
+}
+
 /*
  * PowerPC & X86_64 ELF specifics
  */
@@ -5473,7 +6143,7 @@ ocAllocateSymbolExtras_MachO(ObjectCode* oc)
 
     IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: start\n"));
 
-    for (i = 0; i < header->ncmds; i++) {   
+    for (i = 0; i < header->ncmds; i++) {
         if (lc->cmd == LC_SYMTAB) {
 
                 // Find out the first and last undefined external
@@ -5530,7 +6200,7 @@ ocAllocateSymbolExtras_MachO(ObjectCode* oc)
 
     IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: start\n"));
 
-    for (i = 0; i < header->ncmds; i++) {   
+    for (i = 0; i < header->ncmds; i++) {
         if (lc->cmd == LC_SYMTAB) {
 
                 // Just allocate one entry for every symbol
@@ -5626,8 +6296,8 @@ resolveImports(
 
         if (addr == NULL)
         {
-           errorBelch("\nlookupSymbol failed in resolveImports\n"
-                      "%s: unknown symbol `%s'", oc->fileName, nm);
+            errorBelch("\nlookupSymbol failed in resolveImports\n"
+                       "%s: unknown symbol `%s'", oc->fileName, nm);
             return 0;
         }
         ASSERT(addr);
@@ -5717,14 +6387,14 @@ relocateSection(
         uint64_t baseValue;
         int type = reloc->r_type;
 
-       IF_DEBUG(linker, debugBelch("relocateSection: relocation %d\n", i));
-       IF_DEBUG(linker, debugBelch("               : type      = %d\n", reloc->r_type));
-       IF_DEBUG(linker, debugBelch("               : address   = %d\n", reloc->r_address));
-       IF_DEBUG(linker, debugBelch("               : symbolnum = %u\n", reloc->r_symbolnum));
-       IF_DEBUG(linker, debugBelch("               : pcrel     = %d\n", reloc->r_pcrel));
-       IF_DEBUG(linker, debugBelch("               : length    = %d\n", reloc->r_length));
-       IF_DEBUG(linker, debugBelch("               : extern    = %d\n", reloc->r_extern));
-       IF_DEBUG(linker, debugBelch("               : type      = %d\n", reloc->r_type));
+        IF_DEBUG(linker, debugBelch("relocateSection: relocation %d\n", i));
+        IF_DEBUG(linker, debugBelch("               : type      = %d\n", reloc->r_type));
+        IF_DEBUG(linker, debugBelch("               : address   = %d\n", reloc->r_address));
+        IF_DEBUG(linker, debugBelch("               : symbolnum = %u\n", reloc->r_symbolnum));
+        IF_DEBUG(linker, debugBelch("               : pcrel     = %d\n", reloc->r_pcrel));
+        IF_DEBUG(linker, debugBelch("               : length    = %d\n", reloc->r_length));
+        IF_DEBUG(linker, debugBelch("               : extern    = %d\n", reloc->r_extern));
+        IF_DEBUG(linker, debugBelch("               : type      = %d\n", reloc->r_type));
 
         switch(reloc->r_length)
         {
@@ -5761,51 +6431,51 @@ relocateSection(
         {
             struct nlist *symbol = &nlist[reloc->r_symbolnum];
             char *nm = image + symLC->stroff + symbol->n_un.n_strx;
-           void *addr = NULL;
+            void *addr = NULL;
 
             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);
-           if (reloc->r_extern == 0) {
-                   errorBelch("\nrelocateSection: global offset table relocation for symbol with r_extern == 0\n");
-           }
-
-           if (symbol->n_type & N_EXT) {
-                   // The external bit is set, meaning the symbol is exported,
-                   // and therefore can be looked up in this object module's
-                   // symtab, or it is undefined, meaning dlsym must be used
-                   // to resolve it.
-
-                   addr = lookupSymbol(nm);
-                   IF_DEBUG(linker, debugBelch("relocateSection: looked up %s, "
-                                               "external X86_64_RELOC_GOT or X86_64_RELOC_GOT_LOAD\n", nm));
-                   IF_DEBUG(linker, debugBelch("               : addr = %p\n", addr));
-
-                   if (addr == NULL) {
-                           errorBelch("\nlookupSymbol failed in relocateSection (RELOC_GOT)\n"
-                                      "%s: unknown symbol `%s'", oc->fileName, nm);
-                           return 0;
-                   }
-           } else {
-                   IF_DEBUG(linker, debugBelch("relocateSection: %s is not an exported symbol\n", nm));
-
-                   // The symbol is not exported, or defined in another
-                   // module, so it must be in the current object module,
-                   // at the location given by the section index and
-                   // symbol address (symbol->n_value)
-
-                   if ((symbol->n_type & N_TYPE) == N_SECT) {
-                           addr = (void *)relocateAddress(oc, nSections, sections, symbol->n_value);
-                           IF_DEBUG(linker, debugBelch("relocateSection: calculated relocation %p of "
-                                                       "non-external X86_64_RELOC_GOT or X86_64_RELOC_GOT_LOAD\n",
-                                                       (void *)symbol->n_value));
-                           IF_DEBUG(linker, debugBelch("               : addr = %p\n", addr));
-                   } else {
-                           errorBelch("\nrelocateSection: %s is not exported,"
-                                      " and should be defined in a section, but isn't!\n", nm);
-                   }
-           }
-           
+            if (reloc->r_extern == 0) {
+                    errorBelch("\nrelocateSection: global offset table relocation for symbol with r_extern == 0\n");
+            }
+
+            if (symbol->n_type & N_EXT) {
+                    // The external bit is set, meaning the symbol is exported,
+                    // and therefore can be looked up in this object module's
+                    // symtab, or it is undefined, meaning dlsym must be used
+                    // to resolve it.
+
+                    addr = lookupSymbol(nm);
+                    IF_DEBUG(linker, debugBelch("relocateSection: looked up %s, "
+                                                "external X86_64_RELOC_GOT or X86_64_RELOC_GOT_LOAD\n", nm));
+                    IF_DEBUG(linker, debugBelch("               : addr = %p\n", addr));
+
+                    if (addr == NULL) {
+                            errorBelch("\nlookupSymbol failed in relocateSection (RELOC_GOT)\n"
+                                       "%s: unknown symbol `%s'", oc->fileName, nm);
+                            return 0;
+                    }
+            } else {
+                    IF_DEBUG(linker, debugBelch("relocateSection: %s is not an exported symbol\n", nm));
+
+                    // The symbol is not exported, or defined in another
+                    // module, so it must be in the current object module,
+                    // at the location given by the section index and
+                    // symbol address (symbol->n_value)
+
+                    if ((symbol->n_type & N_TYPE) == N_SECT) {
+                            addr = (void *)relocateAddress(oc, nSections, sections, symbol->n_value);
+                            IF_DEBUG(linker, debugBelch("relocateSection: calculated relocation %p of "
+                                                        "non-external X86_64_RELOC_GOT or X86_64_RELOC_GOT_LOAD\n",
+                                                        (void *)symbol->n_value));
+                            IF_DEBUG(linker, debugBelch("               : addr = %p\n", addr));
+                    } else {
+                            errorBelch("\nrelocateSection: %s is not exported,"
+                                       " and should be defined in a section, but isn't!\n", nm);
+                    }
+            }
+
             value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, (unsigned long)addr)->addr;
 
             type = X86_64_RELOC_SIGNED;
@@ -5814,7 +6484,7 @@ relocateSection(
         {
             struct nlist *symbol = &nlist[reloc->r_symbolnum];
             char *nm = image + symLC->stroff + symbol->n_un.n_strx;
-           void *addr = NULL;
+            void *addr = NULL;
 
             IF_DEBUG(linker, debugBelch("relocateSection: looking up external symbol %s\n", nm));
             IF_DEBUG(linker, debugBelch("               : type  = %d\n", symbol->n_type));
@@ -5829,25 +6499,25 @@ relocateSection(
             }
             else {
                 addr = lookupSymbol(nm);
-               if (addr == NULL)
-               {
-                    errorBelch("\nlookupSymbol failed in relocateSection (relocate external)\n"
-                               "%s: unknown symbol `%s'", oc->fileName, nm);
-                    return 0;
-               }
-
-               value = (uint64_t) addr;
+                if (addr == NULL)
+                {
+                     errorBelch("\nlookupSymbol failed in relocateSection (relocate external)\n"
+                                "%s: unknown symbol `%s'", oc->fileName, nm);
+                     return 0;
+                }
+
+                value = (uint64_t) addr;
                 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).
+            // 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;
+            value = baseValue;
         }
 
         IF_DEBUG(linker, debugBelch("relocateSection: value = %p\n", (void *)value));
@@ -6138,7 +6808,7 @@ relocateSection(
                         return 0;
                     }
 
-                    if (reloc->r_pcrel) {  
+                    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
@@ -6291,6 +6961,7 @@ ocGetNames_MachO(ObjectCode* oc)
         {
 #ifdef USE_MMAP
             char * zeroFillArea = mmapForLinker(sections[i].size, MAP_ANONYMOUS, -1);
+            if (zeroFillArea == NULL) return 0;
             memset(zeroFillArea, 0, sections[i].size);
 #else
             char * zeroFillArea = stgCallocBytes(1,sections[i].size,
@@ -6299,32 +6970,21 @@ ocGetNames_MachO(ObjectCode* oc)
             sections[i].offset = zeroFillArea - image;
         }
 
-        if (!strcmp(sections[i].sectname,"__text")) {
+        SectionKind kind = SECTIONKIND_OTHER;
 
-            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));
+        if (0==strcmp(sections[i].sectname,"__text")) {
+            kind = SECTIONKIND_CODE_OR_RODATA;
         }
-        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 (0==strcmp(sections[i].sectname,"__const") ||
+                 0==strcmp(sections[i].sectname,"__data") ||
+                 0==strcmp(sections[i].sectname,"__bss") ||
+                 0==strcmp(sections[i].sectname,"__common") ||
+                 0==strcmp(sections[i].sectname,"__mod_init_func")) {
+            kind = SECTIONKIND_RWDATA;
         }
-        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,
+        if (kind != SECTIONKIND_OTHER) {
+            addSection(oc, kind,
                 (void*) (image + sections[i].offset),
                 (void*) (image + sections[i].offset + sections[i].size));
         }
@@ -6375,11 +7035,13 @@ ocGetNames_MachO(ObjectCode* oc)
                     else
                     {
                             IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting %s\n", nm));
-                            ghciInsertStrHashTable(oc->fileName, symhash, nm,
+                            ghciInsertSymbolTable(oc->fileName, symhash, nm,
                                                     image
                                                     + sections[nlist[i].n_sect-1].offset
                                                     - sections[nlist[i].n_sect-1].addr
-                                                    + nlist[i].n_value);
+                                                    + nlist[i].n_value,
+                                                    HS_BOOL_FALSE,
+                                                    oc);
                             oc->symbols[curSymbol++] = nm;
                     }
                 }
@@ -6410,8 +7072,8 @@ ocGetNames_MachO(ObjectCode* oc)
                 nlist[i].n_value = commonCounter;
 
                 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting common symbol: %s\n", nm));
-                ghciInsertStrHashTable(oc->fileName, symhash, nm,
-                                       (void*)commonCounter);
+                ghciInsertSymbolTable(oc->fileName, symhash, nm,
+                                       (void*)commonCounter, HS_BOOL_FALSE, oc);
                 oc->symbols[curSymbol++] = nm;
 
                 commonCounter += sz;
@@ -6507,6 +7169,52 @@ ocResolve_MachO(ObjectCode* oc)
     return 1;
 }
 
+static int ocRunInit_MachO ( ObjectCode *oc )
+{
+    char *image = (char*) oc->image;
+    struct mach_header *header = (struct mach_header*) image;
+    struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
+    struct segment_command *segLC = NULL;
+    struct section *sections;
+    nat i;
+
+    for (i = 0; i < header->ncmds; i++) {
+        if (lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64) {
+            segLC = (struct segment_command*) lc;
+        }
+        lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
+    }
+    if (!segLC) {
+        barf("ocRunInit_MachO: no segment load command");
+    }
+    sections = (struct section*) (segLC+1);
+
+    int argc, envc;
+    char **argv, **envv;
+
+    getProgArgv(&argc, &argv);
+    getProgEnvv(&envc, &envv);
+
+    for (i = 0; i < segLC->nsects; i++) {
+        // ToDo: replace this with a proper check for the S_MOD_INIT_FUNC_POINTERS
+        // flag.  We should do this elsewhere in the Mach-O linker code
+        // too.  Note that the system linker will *refuse* to honor
+        // sections which don't have this flag, so this could cause
+        // weird behavior divergence (albeit reproduceable).
+        if (0 == strcmp(sections[i].sectname,"__mod_init_func")) {
+            char *init_startC = image + sections[i].offset;
+            init_t *init = (init_t*)init_startC;
+            init_t *init_end = (init_t*)(init_startC + sections[i].size);
+            for (; init < init_end; init++) {
+                (*init)(argc, argv, envv);
+            }
+        }
+    }
+
+    freeProgEnvv(envc, envv);
+    return 1;
+}
+
 #ifdef powerpc_HOST_ARCH
 /*
  * The Mach-O object format uses leading underscores. But not everywhere.
@@ -6535,7 +7243,7 @@ machoInitSymbolsWithoutUnderscore(void)
 
 #undef SymI_NeedsProto
 #define SymI_NeedsProto(x)  \
-    ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
+    ghciInsertSymbolTable("(GHCi built-in symbols)", symhash, #x, *p++, HS_BOOL_FALSE, NULL);
 
     RTS_MACHO_NOUNDERLINE_SYMBOLS