Commit b5e8b3b1 authored by Simon Marlow's avatar Simon Marlow

Make the linker API thread-safe

We used to be able to rely on the client to use the API in a
single-threaded way, but now that the GC calls into the linker to
unload objects this isn't a safe assumption.
parent 58dcd5c2
...@@ -243,7 +243,11 @@ ...@@ -243,7 +243,11 @@
<itemizedlist> <itemizedlist>
<listitem> <listitem>
<para> <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> </para>
</listitem> </listitem>
</itemizedlist> </itemizedlist>
......
...@@ -260,6 +260,8 @@ void checkUnload (StgClosure *static_objects) ...@@ -260,6 +260,8 @@ void checkUnload (StgClosure *static_objects)
if (unloaded_objects == NULL) return; if (unloaded_objects == NULL) return;
ACQUIRE_LOCK(&linker_mutex);
// Mark every unloadable object as unreferenced initially // Mark every unloadable object as unreferenced initially
for (oc = unloaded_objects; oc; oc = oc->next) { for (oc = unloaded_objects; oc; oc = oc->next) {
IF_DEBUG(linker, debugBelch("Checking whether to unload %" PATH_FMT "\n", IF_DEBUG(linker, debugBelch("Checking whether to unload %" PATH_FMT "\n",
...@@ -317,4 +319,6 @@ void checkUnload (StgClosure *static_objects) ...@@ -317,4 +319,6 @@ void checkUnload (StgClosure *static_objects)
} }
freeHashTable(addrs, NULL); freeHashTable(addrs, NULL);
RELEASE_LOCK(&linker_mutex);
} }
...@@ -155,6 +155,10 @@ ObjectCode *objects = NULL; /* initially empty */ ...@@ -155,6 +155,10 @@ ObjectCode *objects = NULL; /* initially empty */
to be actually freed via checkUnload() */ to be actually freed via checkUnload() */
ObjectCode *unloaded_objects = NULL; /* initially empty */ ObjectCode *unloaded_objects = NULL; /* initially empty */
#ifdef THREADED_RTS
Mutex linker_mutex;
#endif
/* Type of the initializer */ /* Type of the initializer */
typedef void (*init_t) (int argc, char **argv, char **env); typedef void (*init_t) (int argc, char **argv, char **env);
...@@ -1639,6 +1643,7 @@ initLinker_ (int retain_cafs) ...@@ -1639,6 +1643,7 @@ initLinker_ (int retain_cafs)
#if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)) #if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO))
initMutex(&dl_mutex); initMutex(&dl_mutex);
initMutex(&linker_mutex);
#endif #endif
symhash = allocStrHashTable(); symhash = allocStrHashTable();
...@@ -1728,6 +1733,9 @@ exitLinker( void ) { ...@@ -1728,6 +1733,9 @@ exitLinker( void ) {
if (linker_init_done == 1) { if (linker_init_done == 1) {
freeHashTable(symhash, free); freeHashTable(symhash, free);
} }
#ifdef THREADED_RTS
closeMutex(&linker_mutex);
#endif
} }
/* ----------------------------------------------------------------------------- /* -----------------------------------------------------------------------------
...@@ -1889,8 +1897,6 @@ addDLL( pathchar *dll_name ) ...@@ -1889,8 +1897,6 @@ addDLL( pathchar *dll_name )
char line[MAXLINE]; char line[MAXLINE];
int result; int result;
initLinker();
IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name)); IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name));
errmsg = internal_dlopen(dll_name); errmsg = internal_dlopen(dll_name);
...@@ -1952,8 +1958,6 @@ addDLL( pathchar *dll_name ) ...@@ -1952,8 +1958,6 @@ addDLL( pathchar *dll_name )
OpenedDLL* o_dll; OpenedDLL* o_dll;
HINSTANCE instance; HINSTANCE instance;
initLinker();
/* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */ /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
/* See if we've already got it, and ignore if so. */ /* See if we've already got it, and ignore if so. */
...@@ -2022,12 +2026,11 @@ HsInt insertSymbol(pathchar* obj_name, char* key, void* data) ...@@ -2022,12 +2026,11 @@ HsInt insertSymbol(pathchar* obj_name, char* key, void* data)
/* ----------------------------------------------------------------------------- /* -----------------------------------------------------------------------------
* lookup a symbol in the hash table * lookup a symbol in the hash table
*/ */
void * static void* lookupSymbol_ (char *lbl)
lookupSymbol( char *lbl )
{ {
void *val; void *val;
IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl)); IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl));
initLinker() ;
ASSERT(symhash != NULL); ASSERT(symhash != NULL);
if (!ghciLookupSymbolTable(symhash, lbl, &val)) { if (!ghciLookupSymbolTable(symhash, lbl, &val)) {
...@@ -2060,14 +2063,15 @@ lookupSymbol( char *lbl ) ...@@ -2060,14 +2063,15 @@ lookupSymbol( char *lbl )
void* sym; void* sym;
sym = lookupSymbolInDLLs((unsigned char*)lbl); 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 // Also try looking up the symbol without the @N suffix. Some
// DLLs have the suffixes on their symbols, some don't. // DLLs have the suffixes on their symbols, some don't.
zapTrailingAtSign ( (unsigned char*)lbl ); zapTrailingAtSign ( (unsigned char*)lbl );
sym = lookupSymbolInDLLs((unsigned char*)lbl); sym = lookupSymbolInDLLs((unsigned char*)lbl);
if (sym != NULL) { return sym; }; return sym; // might be NULL if not found
return NULL;
# else # else
ASSERT(2+2 == 5); ASSERT(2+2 == 5);
...@@ -2079,6 +2083,14 @@ lookupSymbol( char *lbl ) ...@@ -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 Create a StablePtr for a foreign export. This is normally called by
a C function with __attribute__((constructor)), which is generated a C function with __attribute__((constructor)), which is generated
...@@ -2125,8 +2137,6 @@ void ghci_enquire ( char* addr ) ...@@ -2125,8 +2137,6 @@ void ghci_enquire ( char* addr )
const int DELTA = 64; const int DELTA = 64;
ObjectCode* oc; ObjectCode* oc;
initLinker();
for (oc = objects; oc; oc = oc->next) { for (oc = objects; oc; oc = oc->next) {
for (i = 0; i < oc->n_symbols; i++) { for (i = 0; i < oc->n_symbols; i++) {
sym = oc->symbols[i]; sym = oc->symbols[i];
...@@ -2409,8 +2419,7 @@ isAlreadyLoaded( pathchar *path ) ...@@ -2409,8 +2419,7 @@ isAlreadyLoaded( pathchar *path )
return 0; /* not loaded yet */ return 0; /* not loaded yet */
} }
HsInt static HsInt loadArchive_ (pathchar *path)
loadArchive( pathchar *path )
{ {
ObjectCode* oc; ObjectCode* oc;
char *image; char *image;
...@@ -2451,8 +2460,6 @@ loadArchive( pathchar *path ) ...@@ -2451,8 +2460,6 @@ loadArchive( pathchar *path )
* all resources correctly. This function is pretty complex, so it needs * all resources correctly. This function is pretty complex, so it needs
* to be refactored to make this practical. */ * to be refactored to make this practical. */
initLinker();
IF_DEBUG(linker, debugBelch("loadArchive: start\n")); IF_DEBUG(linker, debugBelch("loadArchive: start\n"));
IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%" PATH_FMT" '\n", path)); IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%" PATH_FMT" '\n", path));
...@@ -2877,13 +2884,20 @@ loadArchive( pathchar *path ) ...@@ -2877,13 +2884,20 @@ loadArchive( pathchar *path )
return 1; 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) * Load an obj (populate the global symbol table, but don't resolve yet)
* *
* Returns: 1 if ok, 0 on error. * Returns: 1 if ok, 0 on error.
*/ */
HsInt static HsInt loadObj_ (pathchar *path)
loadObj( pathchar *path )
{ {
ObjectCode* oc; ObjectCode* oc;
char *image; char *image;
...@@ -2900,8 +2914,6 @@ loadObj( pathchar *path ) ...@@ -2900,8 +2914,6 @@ loadObj( pathchar *path )
#endif #endif
IF_DEBUG(linker, debugBelch("loadObj %" PATH_FMT "\n", path)); IF_DEBUG(linker, debugBelch("loadObj %" PATH_FMT "\n", path));
initLinker();
/* debugBelch("loadObj %s\n", path ); */ /* debugBelch("loadObj %s\n", path ); */
/* Check that we haven't already loaded this object. /* Check that we haven't already loaded this object.
...@@ -2938,7 +2950,9 @@ loadObj( pathchar *path ) ...@@ -2938,7 +2950,9 @@ loadObj( pathchar *path )
image = mmapForLinker(fileSize, 0, fd); image = mmapForLinker(fileSize, 0, fd);
close(fd); close(fd);
if (image == NULL) return 0; if (image == NULL) {
return 0;
}
#else /* !USE_MMAP */ #else /* !USE_MMAP */
/* load the image into memory */ /* load the image into memory */
...@@ -3010,6 +3024,14 @@ loadObj( pathchar *path ) ...@@ -3010,6 +3024,14 @@ loadObj( pathchar *path )
return 1; return 1;
} }
HsInt loadObj (pathchar *path)
{
ACQUIRE_LOCK(&linker_mutex);
HsInt r = loadObj_(path);
RELEASE_LOCK(&linker_mutex);
return r;
}
static HsInt static HsInt
loadOc( ObjectCode* oc ) { loadOc( ObjectCode* oc ) {
int r; int r;
...@@ -3074,14 +3096,12 @@ loadOc( ObjectCode* oc ) { ...@@ -3074,14 +3096,12 @@ loadOc( ObjectCode* oc ) {
* *
* Returns: 1 if ok, 0 on error. * Returns: 1 if ok, 0 on error.
*/ */
HsInt static HsInt resolveObjs_ (void)
resolveObjs( void )
{ {
ObjectCode *oc; ObjectCode *oc;
int r; int r;
IF_DEBUG(linker, debugBelch("resolveObjs: start\n")); IF_DEBUG(linker, debugBelch("resolveObjs: start\n"));
initLinker();
for (oc = objects; oc; oc = oc->next) { for (oc = objects; oc; oc = oc->next) {
if (oc->status != OBJECT_RESOLVED) { if (oc->status != OBJECT_RESOLVED) {
...@@ -3119,11 +3139,18 @@ resolveObjs( void ) ...@@ -3119,11 +3139,18 @@ resolveObjs( void )
return 1; return 1;
} }
HsInt resolveObjs (void)
{
ACQUIRE_LOCK(&linker_mutex);
HsInt r = resolveObjs_();
RELEASE_LOCK(&linker_mutex);
return r;
}
/* ----------------------------------------------------------------------------- /* -----------------------------------------------------------------------------
* delete an object from the pool * delete an object from the pool
*/ */
HsInt static HsInt unloadObj_ (pathchar *path)
unloadObj( pathchar *path )
{ {
ObjectCode *oc, *prev, *next; ObjectCode *oc, *prev, *next;
HsBool unloadedAnyObj = HS_BOOL_FALSE; HsBool unloadedAnyObj = HS_BOOL_FALSE;
...@@ -3131,8 +3158,6 @@ unloadObj( pathchar *path ) ...@@ -3131,8 +3158,6 @@ unloadObj( pathchar *path )
ASSERT(symhash != NULL); ASSERT(symhash != NULL);
ASSERT(objects != NULL); ASSERT(objects != NULL);
initLinker();
IF_DEBUG(linker, debugBelch("unloadObj: %" PATH_FMT "\n", path)); IF_DEBUG(linker, debugBelch("unloadObj: %" PATH_FMT "\n", path));
prev = NULL; prev = NULL;
...@@ -3182,6 +3207,14 @@ unloadObj( pathchar *path ) ...@@ -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 * Sanity checking. For each ObjectCode, maintain a list of address ranges
* which may be prodded during relocation, and abort if we try and write * which may be prodded during relocation, and abort if we try and write
...@@ -4573,7 +4606,7 @@ ocResolve_PEi386 ( ObjectCode* oc ) ...@@ -4573,7 +4606,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
+ ((size_t)(sym->Value)); + ((size_t)(sym->Value));
} else { } else {
copyName ( sym->Name, strtab, symbol, 1000-1 ); 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; if ((void*)S != NULL) goto foundit;
errorBelch("%" PATH_FMT ": unknown symbol `%s'", oc->fileName, symbol); errorBelch("%" PATH_FMT ": unknown symbol `%s'", oc->fileName, symbol);
return 0; return 0;
...@@ -5435,7 +5468,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, ...@@ -5435,7 +5468,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
} else { } else {
symbol = strtab + sym.st_name; symbol = strtab + sym.st_name;
S_tmp = lookupSymbol( symbol ); S_tmp = lookupSymbol_( symbol );
if (S_tmp == NULL) return 0; if (S_tmp == NULL) return 0;
S = (Elf_Addr)S_tmp; S = (Elf_Addr)S_tmp;
} }
...@@ -5746,7 +5779,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, ...@@ -5746,7 +5779,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
} else { } else {
/* No, so look up the name in our global table. */ /* No, so look up the name in our global table. */
symbol = strtab + sym.st_name; symbol = strtab + sym.st_name;
S_tmp = lookupSymbol( symbol ); S_tmp = lookupSymbol_( symbol );
S = (Elf_Addr)S_tmp; S = (Elf_Addr)S_tmp;
#ifdef ELF_FUNCTION_DESC #ifdef ELF_FUNCTION_DESC
...@@ -6295,7 +6328,7 @@ resolveImports( ...@@ -6295,7 +6328,7 @@ resolveImports(
addr = (void*) (symbol->n_value); addr = (void*) (symbol->n_value);
IF_DEBUG(linker, debugBelch("resolveImports: undefined external %s has value %p\n", nm, addr)); IF_DEBUG(linker, debugBelch("resolveImports: undefined external %s has value %p\n", nm, addr));
} else { } else {
addr = lookupSymbol(nm); addr = lookupSymbol_(nm);
IF_DEBUG(linker, debugBelch("resolveImports: looking up %s, %p\n", nm, addr)); IF_DEBUG(linker, debugBelch("resolveImports: looking up %s, %p\n", nm, addr));
} }
...@@ -6451,7 +6484,7 @@ relocateSection( ...@@ -6451,7 +6484,7 @@ relocateSection(
// symtab, or it is undefined, meaning dlsym must be used // symtab, or it is undefined, meaning dlsym must be used
// to resolve it. // to resolve it.
addr = lookupSymbol(nm); addr = lookupSymbol_(nm);
IF_DEBUG(linker, debugBelch("relocateSection: looked up %s, " IF_DEBUG(linker, debugBelch("relocateSection: looked up %s, "
"external X86_64_RELOC_GOT or X86_64_RELOC_GOT_LOAD\n", nm)); "external X86_64_RELOC_GOT or X86_64_RELOC_GOT_LOAD\n", nm));
IF_DEBUG(linker, debugBelch(" : addr = %p\n", addr)); IF_DEBUG(linker, debugBelch(" : addr = %p\n", addr));
...@@ -6503,7 +6536,7 @@ relocateSection( ...@@ -6503,7 +6536,7 @@ relocateSection(
IF_DEBUG(linker, debugBelch("relocateSection, defined external symbol %s, relocated address %p\n", nm, (void *)value)); IF_DEBUG(linker, debugBelch("relocateSection, defined external symbol %s, relocated address %p\n", nm, (void *)value));
} }
else { else {
addr = lookupSymbol(nm); addr = lookupSymbol_(nm);
if (addr == NULL) if (addr == NULL)
{ {
errorBelch("\nlookupSymbol failed in relocateSection (relocate external)\n" errorBelch("\nlookupSymbol failed in relocateSection (relocate external)\n"
...@@ -6806,7 +6839,7 @@ relocateSection( ...@@ -6806,7 +6839,7 @@ relocateSection(
else { else {
struct nlist *symbol = &nlist[reloc->r_symbolnum]; struct nlist *symbol = &nlist[reloc->r_symbolnum];
char *nm = image + symLC->stroff + symbol->n_un.n_strx; char *nm = image + symLC->stroff + symbol->n_un.n_strx;
void *symbolAddress = lookupSymbol(nm); void *symbolAddress = lookupSymbol_(nm);
if (!symbolAddress) { if (!symbolAddress) {
errorBelch("\nunknown symbol `%s'", nm); errorBelch("\nunknown symbol `%s'", nm);
...@@ -7033,7 +7066,7 @@ ocGetNames_MachO(ObjectCode* oc) ...@@ -7033,7 +7066,7 @@ ocGetNames_MachO(ObjectCode* oc)
if(nlist[i].n_type & N_EXT) if(nlist[i].n_type & N_EXT)
{ {
char *nm = image + symLC->stroff + nlist[i].n_un.n_strx; 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 // weak definition, and we already have a definition
IF_DEBUG(linker, debugBelch(" weak: %s\n", nm)); IF_DEBUG(linker, debugBelch(" weak: %s\n", nm));
} }
......
...@@ -144,6 +144,10 @@ typedef struct _ObjectCode { ...@@ -144,6 +144,10 @@ typedef struct _ObjectCode {
extern ObjectCode *objects; extern ObjectCode *objects;
extern ObjectCode *unloaded_objects; extern ObjectCode *unloaded_objects;
#ifdef THREADED_RTS
extern Mutex linker_mutex;
#endif
void exitLinker( void ); void exitLinker( void );
void freeObjectCode (ObjectCode *oc); void freeObjectCode (ObjectCode *oc);
......
...@@ -124,7 +124,7 @@ linker_unload: ...@@ -124,7 +124,7 @@ linker_unload:
$(RM) Test.o Test.hi $(RM) Test.o Test.hi
"$(TEST_HC)" $(TEST_HC_OPTS) -c Test.hs -v0 "$(TEST_HC)" $(TEST_HC_OPTS) -c Test.hs -v0
# -rtsopts causes a warning # -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) ./linker_unload $(BASE) $(GHC_PRIM) $(INTEGER_GMP)
# ----------------------------------------------------------------------------- # -----------------------------------------------------------------------------
...@@ -142,7 +142,7 @@ linker_unload: ...@@ -142,7 +142,7 @@ linker_unload:
.PHONY: linker_error1 .PHONY: linker_error1
linker_error1: linker_error1:
"$(TEST_HC)" -c linker_error.c -o linker_error1.o "$(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_error1 linker_error.c
# linker_error2: the object file has an unknown symbol (fails in # linker_error2: the object file has an unknown symbol (fails in
...@@ -152,7 +152,7 @@ linker_error1: ...@@ -152,7 +152,7 @@ linker_error1:
linker_error2: linker_error2:
"$(TEST_HC)" -c linker_error.c -o linker_error2.o "$(TEST_HC)" -c linker_error.c -o linker_error2.o
"$(TEST_HC)" -c linker_error2.c -o linker_error2_o.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_error2 linker_error2_o.o
# linker_error3: the object file duplicates an existing symbol (fails # linker_error3: the object file duplicates an existing symbol (fails
...@@ -162,5 +162,5 @@ linker_error2: ...@@ -162,5 +162,5 @@ linker_error2:
linker_error3: linker_error3:
"$(TEST_HC)" -c linker_error.c -o linker_error3.o "$(TEST_HC)" -c linker_error.c -o linker_error3.o
"$(TEST_HC)" -c linker_error3.c -o linker_error3_o.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 ./linker_error3 linker_error3_o.o
...@@ -3,6 +3,7 @@ import ObjLink ...@@ -3,6 +3,7 @@ import ObjLink
library_name = "libfoo_script_T2615.so" -- this is really a linker script library_name = "libfoo_script_T2615.so" -- this is really a linker script
main = do main = do
initObjLinker
result <- loadDLL library_name result <- loadDLL library_name
case result of case result of
Nothing -> putStrLn (library_name ++ " loaded successfully") Nothing -> putStrLn (library_name ++ " loaded successfully")
......
...@@ -26,6 +26,7 @@ loadFunction :: Maybe String ...@@ -26,6 +26,7 @@ loadFunction :: Maybe String
-> String -> String
-> IO (Maybe a) -> IO (Maybe a)
loadFunction mpkg m valsym = do loadFunction mpkg m valsym = do
c_initLinker
let symbol = prefixUnderscore let symbol = prefixUnderscore
++ maybe "" (\p -> zEncodeString p ++ "_") mpkg ++ maybe "" (\p -> zEncodeString p ++ "_") mpkg
++ zEncodeString m ++ "_" ++ zEncodeString valsym ++ zEncodeString m ++ "_" ++ zEncodeString valsym
...@@ -39,3 +40,4 @@ loadFunction mpkg m valsym = do ...@@ -39,3 +40,4 @@ loadFunction mpkg m valsym = do
prefixUnderscore = if elem os ["darwin","mingw32","cygwin"] then "_" else "" prefixUnderscore = if elem os ["darwin","mingw32","cygwin"] then "_" else ""
foreign import ccall safe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) 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