Revert "Make the linker API thread-safe"

This reverts commit b5e8b3b162b3ff15ae6caf1afc659565365f54a8.

I reverted it because one of these two patches
  9e6e4796437a7fc23e83605a45db9b2663570123 Add purgeObj()
  b5e8b3b162b3ff15ae6caf1afc659565365f54a8 Make the linker API thread-safe

causes a seg-fault on Windows.  The seg-fault happens immediately
the linker is invoked, in ghci or in Template Haskell.

I believe that it is the "linker API thread-safe" commit that causes
the seg-fault; it happens even if the "purgeObj" commit alone is
reverted.  But since the two patches mess with the same code, to
revert the "linker API" patch I had revert both.

7 files changed, 41 insertions, 89 deletions

diff --git a/docs/users_guide/7.10.1-notes.xml b/docs/users_guide/7.10.1-notes.xml
index b18c4d0fad..596ec16f1b 100644
--- a/docs/users_guide/7.10.1-notes.xml
+++ b/docs/users_guide/7.10.1-notes.xml
@@ -243,11 +243,7 @@
         <itemizedlist>
             <listitem>
                 <para>
-                    The linker API is now thread-safe.  The main
-                    user-facing impact of this change is that you must
-                    now call <literal>initLinker</literal> before
-                    calling <literal>loadObj</literal> or any of the
-                    other linker APIs.
+                    TODO FIXME
                </para>
            </listitem>
        </itemizedlist>
diff --git a/rts/CheckUnload.c b/rts/CheckUnload.c
index 73573fbb34..c63a35a24e 100644
--- a/rts/CheckUnload.c
+++ b/rts/CheckUnload.c
@@ -260,8 +260,6 @@ void checkUnload (StgClosure *static_objects)
 
   if (unloaded_objects == NULL) return;
 
-  ACQUIRE_LOCK(&linker_mutex);
-
   // Mark every unloadable object as unreferenced initially
   for (oc = unloaded_objects; oc; oc = oc->next) {
       IF_DEBUG(linker, debugBelch("Checking whether to unload %" PATH_FMT "\n",
@@ -319,6 +317,4 @@ void checkUnload (StgClosure *static_objects)
   }
 
   freeHashTable(addrs, NULL);
-
-  RELEASE_LOCK(&linker_mutex);
 }
diff --git a/rts/Linker.c b/rts/Linker.c
index ff824b2ef3..a4f6c6b142 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -155,10 +155,6 @@ ObjectCode *objects = NULL;     /* initially empty */
    to be actually freed via checkUnload() */
 ObjectCode *unloaded_objects = NULL; /* initially empty */
 
-#ifdef THREADED_RTS
-Mutex linker_mutex;
-#endif
-
 /* Type of the initializer */
 typedef void (*init_t) (int argc, char **argv, char **env);
 
@@ -1643,7 +1639,6 @@ initLinker_ (int retain_cafs)
 
 #if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO))
     initMutex(&dl_mutex);
-    initMutex(&linker_mutex);
 #endif
     symhash = allocStrHashTable();
 
@@ -1733,9 +1728,6 @@ exitLinker( void ) {
    if (linker_init_done == 1) {
        freeHashTable(symhash, free);
    }
-#ifdef THREADED_RTS
-   closeMutex(&linker_mutex);
-#endif
 }
 
 /* -----------------------------------------------------------------------------
@@ -1922,6 +1914,8 @@ addDLL( pathchar *dll_name )
    char line[MAXLINE];
    int result;
 
+   initLinker();
+
    IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name));
    errmsg = internal_dlopen(dll_name);
 
@@ -1983,6 +1977,8 @@ addDLL( pathchar *dll_name )
    OpenedDLL* o_dll;
    HINSTANCE  instance;
 
+   initLinker();
+
    /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
 
    /* See if we've already got it, and ignore if so. */
@@ -2051,11 +2047,12 @@ HsInt insertSymbol(pathchar* obj_name, char* key, void* data)
 /* -----------------------------------------------------------------------------
  * lookup a symbol in the hash table
  */
-static void* lookupSymbol_ (char *lbl)
+void *
+lookupSymbol( char *lbl )
 {
     void *val;
     IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl));
-
+    initLinker() ;
     ASSERT(symhash != NULL);
 
     if (!ghciLookupSymbolTable(symhash, lbl, &val)) {
@@ -2088,15 +2085,14 @@ static void* lookupSymbol_ (char *lbl)
         void* sym;
 
         sym = lookupSymbolInDLLs((unsigned char*)lbl);
-        if (sym != NULL) {
-            return sym;
-        };
+        if (sym != NULL) { return sym; };
 
         // Also try looking up the symbol without the @N suffix.  Some
         // DLLs have the suffixes on their symbols, some don't.
         zapTrailingAtSign ( (unsigned char*)lbl );
         sym = lookupSymbolInDLLs((unsigned char*)lbl);
-        return sym; // might be NULL if not found
+        if (sym != NULL) { return sym; };
+        return NULL;
 
 #       else
         ASSERT(2+2 == 5);
@@ -2108,14 +2104,6 @@ static void* lookupSymbol_ (char *lbl)
     }
 }
 
-void* lookupSymbol( char *lbl )
-{
-    ACQUIRE_LOCK(&linker_mutex);
-    char *r = lookupSymbol_(lbl);
-    RELEASE_LOCK(&linker_mutex);
-    return r;
-}
-
 /* -----------------------------------------------------------------------------
    Create a StablePtr for a foreign export.  This is normally called by
    a C function with __attribute__((constructor)), which is generated
@@ -2162,6 +2150,8 @@ void ghci_enquire ( char* addr )
    const int DELTA = 64;
    ObjectCode* oc;
 
+   initLinker();
+
    for (oc = objects; oc; oc = oc->next) {
       for (i = 0; i < oc->n_symbols; i++) {
          sym = oc->symbols[i];
@@ -2444,7 +2434,8 @@ isAlreadyLoaded( pathchar *path )
     return 0; /* not loaded yet */
 }
 
-static HsInt loadArchive_ (pathchar *path)
+HsInt
+loadArchive( pathchar *path )
 {
     ObjectCode* oc;
     char *image;
@@ -2485,6 +2476,8 @@ static HsInt loadArchive_ (pathchar *path)
      * 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));
 
@@ -2909,20 +2902,13 @@ static HsInt loadArchive_ (pathchar *path)
     return 1;
 }
 
-HsInt loadArchive (pathchar *path)
-{
-   ACQUIRE_LOCK(&linker_mutex);
-   HsInt r = loadArchive_(path);
-   RELEASE_LOCK(&linker_mutex);
-   return r;
-}
-
 /* -----------------------------------------------------------------------------
  * Load an obj (populate the global symbol table, but don't resolve yet)
  *
  * Returns: 1 if ok, 0 on error.
  */
-static HsInt loadObj_ (pathchar *path)
+HsInt
+loadObj( pathchar *path )
 {
    ObjectCode* oc;
    char *image;
@@ -2939,6 +2925,8 @@ static HsInt loadObj_ (pathchar *path)
 #endif
    IF_DEBUG(linker, debugBelch("loadObj %" PATH_FMT "\n", path));
 
+   initLinker();
+
    /* debugBelch("loadObj %s\n", path ); */
 
    /* Check that we haven't already loaded this object.
@@ -2975,9 +2963,7 @@ static HsInt loadObj_ (pathchar *path)
 
    image = mmapForLinker(fileSize, 0, fd);
    close(fd);
-   if (image == NULL) {
-       return 0;
-   }
+   if (image == NULL) return 0;
 
 #else /* !USE_MMAP */
    /* load the image into memory */
@@ -3049,14 +3035,6 @@ static HsInt loadObj_ (pathchar *path)
    return 1;
 }
 
-HsInt loadObj (pathchar *path)
-{
-   ACQUIRE_LOCK(&linker_mutex);
-   HsInt r = loadObj_(path);
-   RELEASE_LOCK(&linker_mutex);
-   return r;
-}
-
 static HsInt
 loadOc( ObjectCode* oc ) {
    int r;
@@ -3121,12 +3099,14 @@ loadOc( ObjectCode* oc ) {
  *
  * Returns: 1 if ok, 0 on error.
  */
-static HsInt resolveObjs_ (void)
+HsInt
+resolveObjs( void )
 {
     ObjectCode *oc;
     int r;
 
     IF_DEBUG(linker, debugBelch("resolveObjs: start\n"));
+    initLinker();
 
     for (oc = objects; oc; oc = oc->next) {
         if (oc->status != OBJECT_RESOLVED) {
@@ -3164,18 +3144,11 @@ static HsInt resolveObjs_ (void)
     return 1;
 }
 
-HsInt resolveObjs (void)
-{
-    ACQUIRE_LOCK(&linker_mutex);
-    HsInt r = resolveObjs_();
-    RELEASE_LOCK(&linker_mutex);
-    return r;
-}
-
 /* -----------------------------------------------------------------------------
  * delete an object from the pool
  */
-static HsInt unloadObj_ (pathchar *path)
+HsInt
+unloadObj( pathchar *path )
 {
     ObjectCode *oc, *prev, *next;
     HsBool unloadedAnyObj = HS_BOOL_FALSE;
@@ -3183,6 +3156,8 @@ static HsInt unloadObj_ (pathchar *path)
     ASSERT(symhash != NULL);
     ASSERT(objects != NULL);
 
+    initLinker();
+
     IF_DEBUG(linker, debugBelch("unloadObj: %" PATH_FMT "\n", path));
 
     prev = NULL;
@@ -3232,14 +3207,6 @@ static HsInt unloadObj_ (pathchar *path)
     }
 }
 
-HsInt unloadObj (pathchar *path)
-{
-    ACQUIRE_LOCK(&linker_mutex);
-    HsInt r = unloadObj_(path);
-    RELEASE_LOCK(&linker_mutex);
-    return r;
-}
-
 /* -----------------------------------------------------------------------------
  * Sanity checking.  For each ObjectCode, maintain a list of address ranges
  * which may be prodded during relocation, and abort if we try and write
@@ -4631,7 +4598,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
               + ((size_t)(sym->Value));
          } else {
             copyName ( sym->Name, strtab, symbol, 1000-1 );
-            S = (size_t) lookupSymbol_( (char*)symbol );
+            S = (size_t) lookupSymbol( (char*)symbol );
             if ((void*)S != NULL) goto foundit;
             errorBelch("%" PATH_FMT ": unknown symbol `%s'", oc->fileName, symbol);
             return 0;
@@ -5493,7 +5460,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
 
          } else {
             symbol = strtab + sym.st_name;
-            S_tmp = lookupSymbol_( symbol );
+            S_tmp = lookupSymbol( symbol );
             if (S_tmp == NULL) return 0;
             S = (Elf_Addr)S_tmp;
          }
@@ -5804,7 +5771,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
          } else {
             /* No, so look up the name in our global table. */
             symbol = strtab + sym.st_name;
-            S_tmp = lookupSymbol_( symbol );
+            S_tmp = lookupSymbol( symbol );
             S = (Elf_Addr)S_tmp;
 
 #ifdef ELF_FUNCTION_DESC
@@ -6353,7 +6320,7 @@ resolveImports(
             addr = (void*) (symbol->n_value);
             IF_DEBUG(linker, debugBelch("resolveImports: undefined external %s has value %p\n", nm, addr));
         } else {
-            addr = lookupSymbol_(nm);
+            addr = lookupSymbol(nm);
             IF_DEBUG(linker, debugBelch("resolveImports: looking up %s, %p\n", nm, addr));
         }
 
@@ -6509,7 +6476,7 @@ relocateSection(
                     // symtab, or it is undefined, meaning dlsym must be used
                     // to resolve it.
 
-                    addr = lookupSymbol_(nm);
+                    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));
@@ -6561,7 +6528,7 @@ relocateSection(
                 IF_DEBUG(linker, debugBelch("relocateSection, defined external symbol %s, relocated address %p\n", nm, (void *)value));
             }
             else {
-                addr = lookupSymbol_(nm);
+                addr = lookupSymbol(nm);
                 if (addr == NULL)
                 {
                      errorBelch("\nlookupSymbol failed in relocateSection (relocate external)\n"
@@ -6864,7 +6831,7 @@ relocateSection(
                 else {
                     struct nlist *symbol = &nlist[reloc->r_symbolnum];
                     char *nm = image + symLC->stroff + symbol->n_un.n_strx;
-                    void *symbolAddress = lookupSymbol_(nm);
+                    void *symbolAddress = lookupSymbol(nm);
 
                     if (!symbolAddress) {
                         errorBelch("\nunknown symbol `%s'", nm);
@@ -7091,7 +7058,7 @@ ocGetNames_MachO(ObjectCode* oc)
                 if(nlist[i].n_type & N_EXT)
                 {
                     char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
-                    if ((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol_(nm)) {
+                    if ((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm)) {
                         // weak definition, and we already have a definition
                         IF_DEBUG(linker, debugBelch("    weak: %s\n", nm));
                     }
diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
index 4fe533b903..e1942bc8ae 100644
--- a/rts/LinkerInternals.h
+++ b/rts/LinkerInternals.h
@@ -144,10 +144,6 @@ typedef struct _ObjectCode {
 extern ObjectCode *objects;
 extern ObjectCode *unloaded_objects;
 
-#ifdef THREADED_RTS
-extern Mutex linker_mutex;
-#endif
-
 void exitLinker( void );
 
 void freeObjectCode (ObjectCode *oc);
diff --git a/testsuite/tests/rts/Makefile b/testsuite/tests/rts/Makefile
index c943bb4135..8a7cb8af02 100644
--- a/testsuite/tests/rts/Makefile
+++ b/testsuite/tests/rts/Makefile
@@ -124,7 +124,7 @@ 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 -threaded
+	"$(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)
 
 # -----------------------------------------------------------------------------
@@ -142,7 +142,7 @@ linker_unload:
 .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 -threaded
+	"$(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
@@ -152,7 +152,7 @@ linker_error1:
 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 -threaded
+	"$(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
@@ -162,5 +162,5 @@ linker_error2:
 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 -threaded
+	"$(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/T2615.hs b/testsuite/tests/rts/T2615.hs
index 53c2d13ceb..ee04d93bcf 100644
--- a/testsuite/tests/rts/T2615.hs
+++ b/testsuite/tests/rts/T2615.hs
@@ -3,7 +3,6 @@ import ObjLink
 library_name = "libfoo_script_T2615.so" -- this is really a linker script
 
 main = do
-  initObjLinker
   result <- loadDLL library_name
   case result of
     Nothing -> putStrLn (library_name ++ " loaded successfully")
diff --git a/testsuite/tests/rts/rdynamic.hs b/testsuite/tests/rts/rdynamic.hs
index 17f8df76cd..5fb4651ff9 100644
--- a/testsuite/tests/rts/rdynamic.hs
+++ b/testsuite/tests/rts/rdynamic.hs
@@ -26,7 +26,6 @@ loadFunction :: Maybe String
              -> String
            -> IO (Maybe a)
 loadFunction mpkg m valsym = do
-    c_initLinker
     let symbol = prefixUnderscore
                    ++ maybe "" (\p -> zEncodeString p ++ "_") mpkg
                    ++ zEncodeString m ++ "_" ++ zEncodeString valsym
@@ -40,4 +39,3 @@ loadFunction mpkg m valsym = do
     prefixUnderscore = if elem os ["darwin","mingw32","cygwin"] then "_" else ""
 
 foreign import ccall safe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
-foreign import ccall safe "initLinker" c_initLinker :: IO ()