summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--docs/users_guide/7.10.1-notes.xml6
-rw-r--r--rts/CheckUnload.c4
-rw-r--r--rts/Linker.c105
-rw-r--r--rts/LinkerInternals.h4
-rw-r--r--testsuite/tests/rts/Makefile8
-rw-r--r--testsuite/tests/rts/T2615.hs1
-rw-r--r--testsuite/tests/rts/rdynamic.hs2
7 files changed, 89 insertions, 41 deletions
diff --git a/docs/users_guide/7.10.1-notes.xml b/docs/users_guide/7.10.1-notes.xml
index 596ec16f1b..b18c4d0fad 100644
--- a/docs/users_guide/7.10.1-notes.xml
+++ b/docs/users_guide/7.10.1-notes.xml
@@ -243,7 +243,11 @@
<itemizedlist>
<listitem>
<para>
- TODO FIXME
+ 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.
</para>
</listitem>
</itemizedlist>
diff --git a/rts/CheckUnload.c b/rts/CheckUnload.c
index c63a35a24e..73573fbb34 100644
--- a/rts/CheckUnload.c
+++ b/rts/CheckUnload.c
@@ -260,6 +260,8 @@ 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",
@@ -317,4 +319,6 @@ void checkUnload (StgClosure *static_objects)
}
freeHashTable(addrs, NULL);
+
+ RELEASE_LOCK(&linker_mutex);
}
diff --git a/rts/Linker.c b/rts/Linker.c
index 2c74a0dd35..6d9abfe695 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -155,6 +155,10 @@ 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);
@@ -1639,6 +1643,7 @@ initLinker_ (int retain_cafs)
#if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO))
initMutex(&dl_mutex);
+ initMutex(&linker_mutex);
#endif
symhash = allocStrHashTable();
@@ -1728,6 +1733,9 @@ exitLinker( void ) {
if (linker_init_done == 1) {
freeHashTable(symhash, free);
}
+#ifdef THREADED_RTS
+ closeMutex(&linker_mutex);
+#endif
}
/* -----------------------------------------------------------------------------
@@ -1889,8 +1897,6 @@ 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);
@@ -1952,8 +1958,6 @@ 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. */
@@ -2022,12 +2026,11 @@ HsInt insertSymbol(pathchar* obj_name, char* key, void* data)
/* -----------------------------------------------------------------------------
* lookup a symbol in the hash table
*/
-void *
-lookupSymbol( char *lbl )
+static 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)) {
@@ -2060,14 +2063,15 @@ 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);
- if (sym != NULL) { return sym; };
- return NULL;
+ return sym; // might be NULL if not found
# else
ASSERT(2+2 == 5);
@@ -2079,6 +2083,14 @@ 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
@@ -2125,8 +2137,6 @@ 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];
@@ -2409,8 +2419,7 @@ isAlreadyLoaded( pathchar *path )
return 0; /* not loaded yet */
}
-HsInt
-loadArchive( pathchar *path )
+static HsInt loadArchive_ (pathchar *path)
{
ObjectCode* oc;
char *image;
@@ -2451,8 +2460,6 @@ 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));
@@ -2877,13 +2884,20 @@ 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.
*/
-HsInt
-loadObj( pathchar *path )
+static HsInt loadObj_ (pathchar *path)
{
ObjectCode* oc;
char *image;
@@ -2900,8 +2914,6 @@ 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.
@@ -2938,7 +2950,9 @@ 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 */
@@ -3010,6 +3024,14 @@ 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;
@@ -3074,14 +3096,12 @@ loadOc( ObjectCode* oc ) {
*
* Returns: 1 if ok, 0 on error.
*/
-HsInt
-resolveObjs( void )
+static 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) {
@@ -3119,11 +3139,18 @@ 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
*/
-HsInt
-unloadObj( pathchar *path )
+static HsInt unloadObj_ (pathchar *path)
{
ObjectCode *oc, *prev, *next;
HsBool unloadedAnyObj = HS_BOOL_FALSE;
@@ -3131,8 +3158,6 @@ unloadObj( pathchar *path )
ASSERT(symhash != NULL);
ASSERT(objects != NULL);
- initLinker();
-
IF_DEBUG(linker, debugBelch("unloadObj: %" PATH_FMT "\n", path));
prev = NULL;
@@ -3182,6 +3207,14 @@ 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
@@ -4573,7 +4606,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;
@@ -5435,7 +5468,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;
}
@@ -5746,7 +5779,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
@@ -6295,7 +6328,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));
}
@@ -6451,7 +6484,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));
@@ -6503,7 +6536,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"
@@ -6806,7 +6839,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);
@@ -7033,7 +7066,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 e1942bc8ae..4fe533b903 100644
--- a/rts/LinkerInternals.h
+++ b/rts/LinkerInternals.h
@@ -144,6 +144,10 @@ 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 8a7cb8af02..c943bb4135 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 -debug -optc-g
+ "$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS)) linker_unload.c -o linker_unload -no-hs-main -optc-Werror -threaded
./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
+ "$(TEST_HC)" linker_error1.o -o linker_error1 -no-hs-main -optc-g -debug -threaded
./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
+ "$(TEST_HC)" linker_error2.o -o linker_error2 -no-hs-main -optc-g -debug -threaded
./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
+ "$(TEST_HC)" linker_error3.o -o linker_error3 -no-hs-main -optc-g -debug -threaded
./linker_error3 linker_error3_o.o
diff --git a/testsuite/tests/rts/T2615.hs b/testsuite/tests/rts/T2615.hs
index ee04d93bcf..53c2d13ceb 100644
--- a/testsuite/tests/rts/T2615.hs
+++ b/testsuite/tests/rts/T2615.hs
@@ -3,6 +3,7 @@ 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 5fb4651ff9..17f8df76cd 100644
--- a/testsuite/tests/rts/rdynamic.hs
+++ b/testsuite/tests/rts/rdynamic.hs
@@ -26,6 +26,7 @@ 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
@@ -39,3 +40,4 @@ 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 ()
View Lorry Controller Status