Make the linker more robust to errors

Summary:
When linking fails because there was a problem with the supplied
object file, then we should not barf() or exit, we should emit a
suitable error message and return an error code to the caller.  We
should also free all memory that might have been allocated during
linking, and generally not do any damage.  This patch fixes most
common instances of this problem.

Test Plan: validate

Reviewers: rwbarton, austin, ezyang

Reviewed By: ezyang

Subscribers: simonmar, ezyang, carter, thomie

Differential Revision: https://phabricator.haskell.org/D294

8 files changed, 388 insertions, 143 deletions

diff --git a/includes/rts/Linker.h b/includes/rts/Linker.h
index 42d316fc38..c53ad4acc5 100644
--- a/includes/rts/Linker.h
+++ b/includes/rts/Linker.h
@@ -43,7 +43,7 @@ void initLinker (void);
 void initLinker_ (int retain_cafs);
 
 /* insert a symbol in the hash table */
-void insertSymbol(pathchar* obj_name, char* key, void* data);
+HsInt insertSymbol(pathchar* obj_name, char* key, void* data);
 
 /* lookup a symbol in the hash table */
 void *lookupSymbol( char *lbl );
diff --git a/rts/Linker.c b/rts/Linker.c
index e74d647283..4ea7fd6ff7 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -1508,9 +1508,11 @@ static RtsSymbolVal rtsSyms[] = {
 
 /* -----------------------------------------------------------------------------
  * Insert symbols into hash tables, checking for duplicates.
+ *
+ * Returns: 0 on failure, nonzero on success
  */
 
-static void ghciInsertSymbolTable(
+static int ghciInsertSymbolTable(
    pathchar* obj_name,
    HashTable *table,
    char* key,
@@ -1526,20 +1528,22 @@ static void ghciInsertSymbolTable(
       pinfo->owner = owner;
       pinfo->weak = weak;
       insertStrHashTable(table, key, pinfo);
-      return;
-   } else if ((!pinfo->weak || pinfo->value) && weak) {
-     return; /* duplicate weak symbol, throw it away */
-   } else if (pinfo->weak) /* weak symbol is in the table */
+      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;
+      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"
@@ -1547,13 +1551,11 @@ static void ghciInsertSymbolTable(
       "   * 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,
@@ -1637,8 +1639,10 @@ initLinker_ (int retain_cafs)
 
     /* populate the symbol table with stuff from the RTS */
     for (sym = rtsSyms; sym->lbl != NULL; sym++) {
-        ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"),
-                               symhash, sym->lbl, sym->addr, HS_BOOL_FALSE, NULL);
+        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)
@@ -1649,14 +1653,18 @@ initLinker_ (int retain_cafs)
        we cannot use NULL because we use it to mean nonexistent symbols. So we
        use an arbitrary (hopefully unique) address here.
     */
-    ghciInsertSymbolTable(WSTR("(GHCi special symbols)"),
-        symhash, "__dso_handle", (void *)0x12345687, HS_BOOL_FALSE, NULL);
+    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.
-    ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"), symhash,
-                          MAYBE_LEADING_UNDERSCORE_STR("newCAF"),
-                          retain_cafs ? newDynCAF : newCAF,
-                          HS_BOOL_FALSE, NULL);
+    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)
@@ -1712,6 +1720,9 @@ exitLinker( void ) {
 #endif
    }
 #endif
+   if (linker_init_done == 1) {
+       freeHashTable(symhash, free);
+   }
 }
 
 /* -----------------------------------------------------------------------------
@@ -1994,11 +2005,12 @@ error:
 
 /* -----------------------------------------------------------------------------
  * 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)
 {
-  ghciInsertSymbolTable(obj_name, symhash, key, data, HS_BOOL_FALSE, NULL);
+    return ghciInsertSymbolTable(obj_name, symhash, key, data, HS_BOOL_FALSE, NULL);
 }
 
 /* -----------------------------------------------------------------------------
@@ -2131,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"));
@@ -2151,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)
@@ -2169,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
@@ -2190,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)
@@ -2200,15 +2229,53 @@ 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;
 
@@ -2222,7 +2289,7 @@ void freeObjectCode (ObjectCode *oc)
 
 #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)
+    if (!USE_CONTIGUOUS_MMAP && oc->symbol_extras != NULL)
     {
         munmap(oc->symbol_extras,
                ROUND_UP(sizeof(SymbolExtra) * oc->n_symbol_extras, pagesize));
@@ -2273,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";
@@ -2302,6 +2369,7 @@ mkOc( pathchar *path, char *image, int imageSize,
    oc->sections          = NULL;
    oc->proddables        = NULL;
    oc->stable_ptrs       = NULL;
+   oc->symbol_extras     = NULL;
 
 #ifndef USE_MMAP
 #ifdef darwin_HOST_OS
@@ -2310,8 +2378,7 @@ 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;
@@ -2372,6 +2439,10 @@ 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"));
@@ -2733,6 +2804,9 @@ loadArchive( pathchar *path )
                 stgFree(fileName);
                 fclose(f);
                 return 0;
+            } else {
+                oc->next = objects;
+                objects = oc;
             }
         }
         else if (isGnuIndex) {
@@ -2849,19 +2923,23 @@ loadObj( pathchar *path )
    /* 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
@@ -2871,6 +2949,10 @@ loadObj( pathchar *path )
        f, path, "itself",
 #endif
        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
     // if the total size of the headers is not a multiple of the
@@ -2891,10 +2973,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
@@ -2905,7 +2990,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
@@ -2914,6 +3008,21 @@ loadOc( ObjectCode* oc ) {
 
    IF_DEBUG(linker, debugBelch("loadOc: start\n"));
 
+   /* verify the in-memory image */
+#  if defined(OBJFORMAT_ELF)
+   r = ocVerifyImage_ELF ( oc );
+#  elif defined(OBJFORMAT_PEi386)
+   r = ocVerifyImage_PEi386 ( oc );
+#  elif defined(OBJFORMAT_MACHO)
+   r = ocVerifyImage_MachO ( oc );
+#  else
+   barf("loadObj: no verify method");
+#  endif
+   if (!r) {
+       IF_DEBUG(linker, debugBelch("loadOc: ocVerifyImage_* failed\n"));
+       return r;
+   }
+
 #  if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
    r = ocAllocateSymbolExtras_MachO ( oc );
    if (!r) {
@@ -2930,21 +3039,6 @@ loadOc( ObjectCode* oc ) {
    ocAllocateSymbolExtras_PEi386 ( oc );
 #endif
 
-   /* verify the in-memory image */
-#  if defined(OBJFORMAT_ELF)
-   r = ocVerifyImage_ELF ( oc );
-#  elif defined(OBJFORMAT_PEi386)
-   r = ocVerifyImage_PEi386 ( oc );
-#  elif defined(OBJFORMAT_MACHO)
-   r = ocVerifyImage_MachO ( oc );
-#  else
-   barf("loadObj: no verify method");
-#  endif
-   if (!r) {
-       IF_DEBUG(linker, debugBelch("loadOc: ocVerifyImage_* failed\n"));
-       return r;
-   }
-
    /* build the symbol list for this image */
 #  if defined(OBJFORMAT_ELF)
    r = ocGetNames_ELF ( oc );
@@ -3039,17 +3133,7 @@ unloadObj( pathchar *path )
 
         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) {
-                       ghciRemoveSymbolTable(symhash, oc->symbols[i], oc);
-                   }
-                }
-            }
+            removeOcSymbols(oc);
 
             if (prev == NULL) {
                 objects = oc->next;
@@ -3059,23 +3143,6 @@ unloadObj( pathchar *path )
             oc->next = unloaded_objects;
             unloaded_objects = oc;
 
-            // The data itself and a few other bits (oc->fileName,
-            // oc->archiveMemberName) are kept until freeObjectCode(),
-            // which is only called when it has been determined that
-            // it is safe to unload the object.
-            stgFree(oc->symbols);
-
-            {
-                Section *s, *nexts;
-
-                for (s = oc->sections; s != NULL; s = nexts) {
-                    nexts = s->next;
-                    stgFree(s);
-                }
-            }
-
-            freeProddableBlocks(oc);
-
             // Release any StablePtrs that were created when this
             // object module was initialized.
             {
@@ -3242,13 +3309,16 @@ static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
                 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
@@ -3584,6 +3654,8 @@ 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.
  */
@@ -3602,11 +3674,17 @@ allocateImageAndTrampolines (
    size_t n;
 
    n = fread ( &hdr, 1, sizeof_COFF_header, f );
-   if (n != sizeof( COFF_header ))
-       barf("getNumberOfSymbols: error whilst reading `%s' header in `%S'",
-             member_name, arch_name);
+   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
@@ -3622,6 +3700,13 @@ allocateImageAndTrampolines (
    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);
+       return NULL;
+   }
+
    return image + PEi386_IMAGE_OFFSET;
 }
 
@@ -3853,37 +3938,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
@@ -3891,23 +3956,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. */
@@ -4199,7 +4294,9 @@ ocGetNames_PEi386 ( ObjectCode* oc )
 
       if (kind != SECTIONKIND_OTHER && end >= start) {
           if ((((size_t)(start)) % 4) != 0) {
-              barf("Misaligned section %s: %p", (char*)secname, start);
+              errorBelch("Misaligned section %s: %p", (char*)secname, start);
+              stgFree(secname);
+              return 0;
           }
 
          addSection(oc, kind, start, end);
@@ -4263,8 +4360,10 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          ASSERT(i >= 0 && i < oc->n_symbols);
          /* cstring_from_COFF_symbol_name always succeeds. */
          oc->symbols[i] = (char*)sname;
-         ghciInsertSymbolTable(oc->fileName, symhash, (char*)sname, addr,
-            HS_BOOL_FALSE, oc);
+         if (! ghciInsertSymbolTable(oc->fileName, symhash, (char*)sname, addr,
+                                     HS_BOOL_FALSE, oc)) {
+             return 0;
+         }
       } else {
 #        if 0
          debugBelch(
@@ -5150,8 +5249,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
@@ -5224,12 +5326,15 @@ ocGetNames_ELF ( ObjectCode* oc )
 
          if (ad != NULL) {
             ASSERT(nm != NULL);
-            oc->symbols[j] = nm;
             /* Acquire! */
             if (isLocal) {
                /* Ignore entirely. */
             } else {
-               ghciInsertSymbolTable(oc->fileName, symhash, nm, ad, isWeak, oc);
+                if (! ghciInsertSymbolTable(oc->fileName, symhash,
+                                            nm, ad, isWeak, oc)) {
+                    return 0;
+                }
+                oc->symbols[j] = nm;
             }
          } else {
             /* Skip. */
@@ -5323,6 +5428,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
          } else {
             symbol = strtab + sym.st_name;
             S_tmp = lookupSymbol( symbol );
+            if (S_tmp == NULL) return 0;
             S = (Elf_Addr)S_tmp;
          }
          if (!S) {
@@ -5764,8 +5870,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;
@@ -5790,8 +5897,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;
@@ -5808,8 +5916,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;
@@ -6849,6 +6958,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,
diff --git a/testsuite/tests/rts/Makefile b/testsuite/tests/rts/Makefile
index 02a50a4644..8a7cb8af02 100644
--- a/testsuite/tests/rts/Makefile
+++ b/testsuite/tests/rts/Makefile
@@ -104,15 +104,15 @@ T7040_ghci_setup :
 
 LOCAL_GHC_PKG = '$(GHC_PKG)' --no-user-package-db
 
-BASE_DIR = $(shell $(LOCAL_GHC_PKG) field base library-dirs | sed 's/^.*: *//')
-BASE_LIB = $(shell $(LOCAL_GHC_PKG) field base hs-libraries | sed 's/^.*: *//')
-GHC_PRIM_DIR = $(shell $(LOCAL_GHC_PKG) field ghc-prim library-dirs | sed 's/^.*: *//')
-GHC_PRIM_LIB = $(shell $(LOCAL_GHC_PKG) field ghc-prim hs-libraries | sed 's/^.*: *//')
+BASE_DIR = $(shell $(LOCAL_GHC_PKG) field base library-dirs | sed 's/^[^:]*: *//')
+BASE_LIB = $(shell $(LOCAL_GHC_PKG) field base hs-libraries | sed 's/^[^:]*: *//')
+GHC_PRIM_DIR = $(shell $(LOCAL_GHC_PKG) field ghc-prim library-dirs | sed 's/^[^:]*: *//')
+GHC_PRIM_LIB = $(shell $(LOCAL_GHC_PKG) field ghc-prim hs-libraries | sed 's/^[^:]*: *//')
 # We need to get first library directory here in order to get rid of
 # system gmp library directory installation when ghc is configured
 # with --with-gmp-libraries=<dir> parameter
 INTEGER_GMP_DIR = $(shell $(LOCAL_GHC_PKG) field integer-gmp library-dirs \
-	| sed 's/^.*: *//' | head -1)
+	| sed 's/^[^:]*: *//' | head -1)
 INTEGER_GMP_LIB = $(shell $(LOCAL_GHC_PKG) field integer-gmp hs-libraries | sed 's/^.*: *//')
 
 BASE        = $(BASE_DIR)/lib$(BASE_LIB).a
@@ -124,5 +124,43 @@ linker_unload:
 	$(RM) Test.o Test.hi
 	"$(TEST_HC)" $(TEST_HC_OPTS) -c Test.hs -v0
 	# -rtsopts causes a warning
-	"$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS)) linker_unload.c -o linker_unload -no-hs-main -optc-Werror
+	"$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS)) linker_unload.c -o linker_unload -no-hs-main -optc-Werror -debug -optc-g
 	./linker_unload $(BASE) $(GHC_PRIM) $(INTEGER_GMP)
+
+# -----------------------------------------------------------------------------
+# Testing failures in the RTS linker.  We should be able to repeatedly
+# load bogus object files of various kinds without crashing and
+# without any memory leaks.
+#
+# Check for memory leaks manually by running e.g.
+#
+# make linker_error1
+# valgrind --leak-check=full --show-reachable=yes ./linker_error1 linker_error1_o.o
+
+# linker_error1: not a valid object file
+
+.PHONY: linker_error1
+linker_error1:
+	"$(TEST_HC)" -c linker_error.c -o linker_error1.o
+	"$(TEST_HC)" linker_error1.o -o linker_error1 -no-hs-main -optc-g -debug
+	./linker_error1 linker_error.c
+
+# linker_error2: the object file has an unknown symbol (fails in
+# resolveObjs())
+
+.PHONY: linker_error2
+linker_error2:
+	"$(TEST_HC)" -c linker_error.c -o linker_error2.o
+	"$(TEST_HC)" -c linker_error2.c -o linker_error2_o.o
+	"$(TEST_HC)" linker_error2.o -o linker_error2 -no-hs-main -optc-g -debug
+	./linker_error2 linker_error2_o.o
+
+# linker_error3: the object file duplicates an existing symbol (fails
+# in loadObj())
+
+.PHONY: linker_error3
+linker_error3:
+	"$(TEST_HC)" -c linker_error.c -o linker_error3.o
+	"$(TEST_HC)" -c linker_error3.c -o linker_error3_o.o
+	"$(TEST_HC)" linker_error3.o -o linker_error3 -no-hs-main -optc-g -debug
+	./linker_error3 linker_error3_o.o
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index d4948727e3..015a9c7f90 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -244,3 +244,20 @@ test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip)
 test('overflow1', [ exit_code(251) ], compile_and_run, [''])
 test('overflow2', [ exit_code(251) ], compile_and_run, [''])
 test('overflow3', [ exit_code(251) ], compile_and_run, [''])
+
+test('linker_error1',
+     [ extra_clean(['linker_error1.o','linker_error1']), ignore_output ],
+     run_command,
+     ['$MAKE -s --no-print-directory linker_error1'])
+
+test('linker_error2',
+     [ extra_clean(['linker_error2.o','linker_error2_c.o', 'linker_error2']),
+       ignore_output ],
+     run_command,
+     ['$MAKE -s --no-print-directory linker_error2'])
+
+test('linker_error3',
+     [ extra_clean(['linker_error3.o','linker_error3_c.o', 'linker_error3']),
+       ignore_output ],
+     run_command,
+     ['$MAKE -s --no-print-directory linker_error3'])
diff --git a/testsuite/tests/rts/linker_error.c b/testsuite/tests/rts/linker_error.c
new file mode 100644
index 0000000000..60d24a5aca
--- /dev/null
+++ b/testsuite/tests/rts/linker_error.c
@@ -0,0 +1,66 @@
+#include "ghcconfig.h"
+#include <stdio.h>
+#include <stdlib.h>
+#include "Rts.h"
+
+#define ITERATIONS 10
+
+typedef int testfun(int);
+
+int main (int argc, char *argv[])
+{
+    testfun *f;
+    int i, r;
+#if defined(mingw32_HOST_OS)
+    wchar_t *obj;
+#else
+    char *obj;
+#endif
+
+    hs_init(&argc, &argv);
+
+    initLinker_(0);
+
+    // Load object file argv[1] repeatedly
+
+    if (argc != 2) {
+        errorBelch("syntax: linker_error <object-file>");
+        exit(1);
+    }
+
+#if defined(mingw32_HOST_OS)
+    size_t len = mbstowcs(NULL, argv[1], 0) + 1;
+    if (len == -1) {
+        errorBelch("invalid multibyte sequence in argument %d: %s", i, argv[i]);
+        exit(1);
+    }
+    wchar_t *buf = (wchar_t*)_alloca(len * sizeof(wchar_t));
+    size_t len2 = mbstowcs(buf, argv[1], len);
+    if (len != len2 + 1) {
+        errorBelch("something fishy is going on in argument %d: %s", i, argv[i]);
+        exit(1);
+    }
+    obj = buf;
+#else
+    obj = argv[1];
+#endif
+
+    for (i=0; i < ITERATIONS; i++) {
+        r = loadObj(obj);
+        if (!r) {
+            debugBelch("loadObj(%s) failed", obj);
+            continue;
+        }
+        r = resolveObjs();
+        if (!r) {
+            debugBelch("resolveObjs failed");
+            unloadObj(obj);
+            continue;
+        }
+        errorBelch("loading succeeded");
+        exit(1);
+    }
+
+    hs_exit();
+    return 0;
+}
diff --git a/testsuite/tests/rts/linker_error2.c b/testsuite/tests/rts/linker_error2.c
new file mode 100644
index 0000000000..2687833ff5
--- /dev/null
+++ b/testsuite/tests/rts/linker_error2.c
@@ -0,0 +1,6 @@
+extern int bar;
+
+int foo(void)
+{
+    return bar;
+}
diff --git a/testsuite/tests/rts/linker_error3.c b/testsuite/tests/rts/linker_error3.c
new file mode 100644
index 0000000000..00faa741c7
--- /dev/null
+++ b/testsuite/tests/rts/linker_error3.c
@@ -0,0 +1,6 @@
+extern int bar;
+
+int stg_upd_frame_info(void)
+{
+    return bar;
+}
diff --git a/testsuite/tests/rts/linker_unload.c b/testsuite/tests/rts/linker_unload.c
index f1cc891df1..4980eeb47f 100644
--- a/testsuite/tests/rts/linker_unload.c
+++ b/testsuite/tests/rts/linker_unload.c
@@ -29,7 +29,9 @@ int main (int argc, char *argv[])
     testfun *f;
     int i, r;
 
-    hs_init(&argc, &argv);
+    RtsConfig conf = defaultRtsConfig;
+    conf.rts_opts_enabled = RtsOptsAll;
+    hs_init_ghc(&argc, &argv, conf);
 
     initLinker_(0);