Commit 55a2a0b4 authored by Simon Marlow's avatar Simon Marlow

Revert "Revert "Make the linker API thread-safe""

Also includes a fix for the segfaults on Windows caused by the original
version of this patch.

This reverts commit 4b51194d.
parent 78edd760
......@@ -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>
......
......@@ -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);
}
......@@ -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);
......@@ -1637,8 +1641,11 @@ initLinker_ (int retain_cafs)
objects = NULL;
unloaded_objects = NULL;
#if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO))
#if defined(THREADED_RTS)
initMutex(&linker_mutex);
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
initMutex(&dl_mutex);
#endif
#endif
symhash = allocStrHashTable();
......@@ -1728,6 +1735,9 @@ exitLinker( void ) {
if (linker_init_done == 1) {
freeHashTable(symhash, free);
}
#ifdef THREADED_RTS
closeMutex(&linker_mutex);
#endif
}
/* -----------------------------------------------------------------------------
......@@ -1914,8 +1924,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);
......@@ -1977,8 +1985,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. */
......@@ -2047,12 +2053,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)) {
......@@ -2085,14 +2090,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);
......@@ -2104,6 +2110,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
......@@ -2150,8 +2164,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];
......@@ -2434,8 +2446,7 @@ isAlreadyLoaded( pathchar *path )
return 0; /* not loaded yet */
}
HsInt
loadArchive( pathchar *path )
static HsInt loadArchive_ (pathchar *path)
{
ObjectCode* oc;
char *image;
......@@ -2476,8 +2487,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));
......@@ -2902,13 +2911,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;
......@@ -2925,8 +2941,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.
......@@ -2963,7 +2977,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 */
......@@ -3035,6 +3051,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;
......@@ -3099,14 +3123,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) {
......@@ -3144,11 +3166,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;
......@@ -3156,8 +3185,6 @@ unloadObj( pathchar *path )
ASSERT(symhash != NULL);
ASSERT(objects != NULL);
initLinker();
IF_DEBUG(linker, debugBelch("unloadObj: %" PATH_FMT "\n", path));
prev = NULL;
......@@ -3207,6 +3234,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
......@@ -4598,7 +4633,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;
......@@ -5460,7 +5495,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;
}
......@@ -5771,7 +5806,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
......@@ -6320,7 +6355,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));
}
......@@ -6476,7 +6511,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));
......@@ -6528,7 +6563,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"
......@@ -6831,7 +6866,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);
......@@ -7058,7 +7093,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));
}
......
......@@ -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);
......
......@@ -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
......@@ -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")
......
......@@ -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 ()
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment