[Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 4 commits: No wait that was right and that was the previous interface
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Tue Mar 19 17:51:24 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC
Commits:
56fb5416 by Rodrigo Mesquita at 2024-03-19T16:24:22+00:00
No wait that was right and that was the previous interface
- - - - -
9e78dc4a by Rodrigo Mesquita at 2024-03-19T16:24:30+00:00
Start writing test
- - - - -
e28f0a71 by Rodrigo Mesquita at 2024-03-19T16:24:30+00:00
modify some things
- - - - -
d408a07a by Rodrigo Mesquita at 2024-03-19T17:50:57+00:00
Refactor loadNativeObj_ELF to _POSIX and delete dl_mutex
- - - - -
16 changed files:
- + NOTES
- + T23415/Makefile
- + T23415/main.hs
- + T23415/make_shared_libs.sh
- + T23415/run_test.sh
- + T23415/test.c
- libraries/ghci/GHCi/ObjLink.hs
- rts/Linker.c
- rts/LinkerInternals.h
- rts/include/rts/Linker.h
- rts/linker/Elf.c
- rts/linker/Elf.h
- + rts/linker/LoadNativeObjPosix.c
- + rts/linker/LoadNativeObjPosix.h
- rts/linker/PEi386.c
- rts/rts.cabal
Changes:
=====================================
NOTES
=====================================
@@ -0,0 +1,2 @@
+all linker calls need to be locked linker_mutex to lock global linker datastructures
+dl_mutex is subsumed by linker_mutex, get rid of it entirely
=====================================
T23415/Makefile
=====================================
@@ -0,0 +1,10 @@
+.PHONY: run build clean
+
+run:
+ sh run_test.sh
+
+build:
+ sh make_shared_libs.sh
+
+clean:
+ rm -f lib*.out main main.o main.hi test.o tags
=====================================
T23415/main.hs
=====================================
@@ -0,0 +1,25 @@
+import Control.Monad
+import System.FilePath
+import System.Directory
+import GHCi.ObjLink
+
+foreign import ccall unsafe "loadLibXXXObjs" loadLibsObjs :: IO Int
+foreign import ccall unsafe "loadLibSymbols" loadLibSymbols :: IO Int
+
+hsLoadObjs = do
+ cwd <- getCurrentDirectory
+ forM_ [0..499] $ \i ->
+ loadDLL (cwd </> "lib" ++ show i ++ ".out")
+
+hsLoadSymbols = do
+ forM_ [0..499] $ \i ->
+ forM_ [0..99] $ \j ->
+ lookupSymbol ("lib" ++ show i ++ "_" ++ show j)
+
+main = do
+ -- print =<< loadLibsObjs
+ -- print =<< loadLibSymbols
+
+ initObjLinker RetainCAFs
+ hsLoadObjs
+ hsLoadSymbols
=====================================
T23415/make_shared_libs.sh
=====================================
@@ -0,0 +1,20 @@
+#!/bin/sh
+
+example_dylib=$(basename -- $(find $(ghc --print-libdir) -name libHS* -not -name *.a | head -n1))
+dylib_ext="${example_dylib##*.}"
+# we try .out instead of using the correct extension.
+
+i=0
+while [ $i -lt 500 ]; do
+ j=0
+ while [ $j -lt 100 ]; do
+ echo "int lib${i}_$j(void) { return $i; }" >> "lib$i.c"
+ j=$(( j + 1 ))
+ done
+ cc -o "lib$i.o" -c "lib$i.c" -fPIC
+ cc -shared "lib$i.o" -o "lib$i.out" # "lib$i.$dylib_ext"
+ rm "lib$i.c" "lib$i.o"
+ i=$(( i + 1 ))
+done
+
+
=====================================
T23415/run_test.sh
=====================================
@@ -0,0 +1,6 @@
+#!/bin/sh
+
+GHC=/Users/romes/ghc-dev/ghc/_build/stage1/bin/ghc
+
+$GHC --interactive test.c main.hs -package directory -package ghci -package filepath
+
=====================================
T23415/test.c
=====================================
@@ -0,0 +1,28 @@
+#include <time.h>
+#include <stdlib.h>
+#include <Rts.h>
+#include <rts/Linker.h>
+
+int loadLibXXXObjs(void) {
+
+ for (int i=0; i<500; i++) {
+ char path[16];
+ char* err;
+ sprintf(path, "lib%d.out", i);
+ // loadNativeObj(path, &err);
+ addDLL(path);
+ }
+
+ return 0;
+}
+
+int loadLibSymbols(void) {
+ initLinker();
+ for (int i=0; i<500; i++) {
+ char path[16];
+ sprintf(path, "lib%d", i);
+ printf("loading %s\n", path);
+ lookupSymbol(path);
+ }
+ return 0;
+}
=====================================
libraries/ghci/GHCi/ObjLink.hs
=====================================
@@ -74,7 +74,7 @@ lookupSymbolInDLL :: Ptr LoadedDLL -> String -> IO (Maybe (Ptr a))
lookupSymbolInDLL dll str_in = do
let str = prefixUnderscore str_in
withCAString str $ \c_str -> do
- addr <- c_lookupSymbolInDLL dll c_str
+ addr <- c_lookupSymbolInNativeObj dll c_str
if addr == nullPtr
then return Nothing
else return (Just addr)
@@ -112,7 +112,7 @@ loadDLL str0 = do
--
(maybe_handle, maybe_errmsg) <- withFilePath (normalise str) $ \dll ->
alloca $ \errmsg_ptr -> (,)
- <$> c_addDLL dll errmsg_ptr
+ <$> c_loadNativeObj dll errmsg_ptr
<*> peek errmsg_ptr
if maybe_handle == nullPtr
@@ -176,8 +176,8 @@ resolveObjs = do
-- Foreign declarations to RTS entry points which does the real work;
-- ---------------------------------------------------------------------------
-foreign import ccall unsafe "loadNativeObj" c_addDLL :: CFilePath -> Ptr CString -> IO (Ptr LoadedDLL)
-foreign import ccall unsafe "lookupSymbolInNativeObj" c_lookupSymbolInDLL :: Ptr LoadedDLL -> CString -> IO (Ptr a)
+foreign import ccall unsafe "loadNativeObj" c_loadNativeObj :: CFilePath -> Ptr CString -> IO (Ptr LoadedDLL)
+foreign import ccall unsafe "lookupSymbolInNativeObj" c_lookupSymbolInNativeObj :: Ptr LoadedDLL -> CString -> IO (Ptr a)
foreign import ccall unsafe "initLinker_" c_initLinker_ :: CInt -> IO ()
foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
foreign import ccall unsafe "loadArchive" c_loadArchive :: CFilePath -> IO Int
=====================================
rts/Linker.c
=====================================
@@ -77,6 +77,10 @@
# include <mach-o/fat.h>
#endif
+#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+# include "linker/LoadNativeObjPosix.h"
+#endif
+
#if defined(dragonfly_HOST_OS)
#include <sys/tls.h>
#endif
@@ -419,9 +423,6 @@ static int linker_init_done = 0 ;
static void *dl_prog_handle;
static regex_t re_invalid;
static regex_t re_realso;
-#if defined(THREADED_RTS)
-Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
-#endif
#endif
void initLinker (void)
@@ -455,9 +456,6 @@ initLinker_ (int retain_cafs)
#if defined(THREADED_RTS)
initMutex(&linker_mutex);
-#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
- initMutex(&dl_mutex);
-#endif
#endif
symhash = allocStrHashTable();
@@ -520,9 +518,6 @@ exitLinker( void ) {
if (linker_init_done == 1) {
regfree(&re_invalid);
regfree(&re_realso);
-#if defined(THREADED_RTS)
- closeMutex(&dl_mutex);
-#endif
}
#endif
if (linker_init_done == 1) {
@@ -578,8 +573,8 @@ static void *
internal_dlsym(const char *symbol) {
void *v;
- // We acquire dl_mutex as concurrent dl* calls may alter dlerror
- ACQUIRE_LOCK(&dl_mutex);
+ // concurrent dl* calls may alter dlerror
+ ASSERT_LOCK_HELD(&linker_mutex);
// clears dlerror
dlerror();
@@ -587,7 +582,6 @@ internal_dlsym(const char *symbol) {
// look in program first
v = dlsym(dl_prog_handle, symbol);
if (dlerror() == NULL) {
- RELEASE_LOCK(&dl_mutex);
IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol));
return v;
}
@@ -597,12 +591,10 @@ internal_dlsym(const char *symbol) {
v = dlsym(nc->dlopen_handle, symbol);
if (dlerror() == NULL) {
IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol));
- RELEASE_LOCK(&dl_mutex);
return v;
}
}
}
- RELEASE_LOCK(&dl_mutex);
IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol));
# define SPECIAL_SYMBOL(sym) \
@@ -645,34 +637,30 @@ internal_dlsym(const char *symbol) {
void *lookupSymbolInNativeObj(void *handle, const char *symbol_name)
{
+ ASSERT_LOCK_HELD(&linker_mutex);
+
#if defined(OBJFORMAT_MACHO)
CHECK(symbol_name[0] == '_');
symbol_name = symbol_name+1;
#endif
-
- ACQUIRE_LOCK(&dl_mutex); // dlsym alters dlerror
void *result = dlsym(handle, symbol_name);
- RELEASE_LOCK(&dl_mutex);
return result;
}
# endif
-// A backwards-compatibility shim wrapping `loadNativeObj`.
-void *addDLL(pathchar* dll_name, const char **errmsg_ptr)
+const char *addDLL(pathchar* dll_name)
{
# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
- void *dll_handle;
- if (!(dll_handle = loadNativeObj(dll_name, &errmsg_ptr))) {
- ASSERT(*errmsg_ptr != NULL);
+ char *errmsg;
+ if (loadNativeObj(dll_name, &errmsg)) {
return NULL;
+ } else {
+ ASSERT(errmsg != NULL);
+ return errmsg;
}
- return dll_handle;
# elif defined(OBJFORMAT_PEi386)
- // FIXME: romes:question: why was this FIXME here, is it the NULL?
- *errmsg_ptr = addDLL_PEi386(dll_name, NULL);
- // ROMES:question: Does the caller know that they have to free the error message pointed to by the given argument pointer?
- return NULL;
+ return addDLL_PEi386(dll_name);
# else
barf("addDLL: not implemented on this platform");
@@ -1104,9 +1092,10 @@ void freeObjectCode (ObjectCode *oc)
if (oc->type == DYNAMIC_OBJECT) {
#if defined(OBJFORMAT_ELF)
- ACQUIRE_LOCK(&dl_mutex);
+ // ROMES:TODO: This previously acquired dl_mutex. Check that acquiring linker_mutex here is fine.
+ ACQUIRE_LOCK(&linker_mutex);
freeNativeCode_ELF(oc);
- RELEASE_LOCK(&dl_mutex);
+ RELEASE_LOCK(&linker_mutex);
#else
barf("freeObjectCode: This shouldn't happen");
#endif
@@ -1876,68 +1865,15 @@ void * loadNativeObj (pathchar *path, char **errmsg)
{
IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path));
ACQUIRE_LOCK(&linker_mutex);
- void *r = loadNativeObj_ELF(path, errmsg);
+ void *r = loadNativeObj_POSIX(path, errmsg);
- if (r) {
- RELEASE_LOCK(&linker_mutex);
- return r;
- }
-
- // GHC #2615
- // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so)
- // contain linker scripts rather than ELF-format object code. This
- // code handles the situation by recognizing the real object code
- // file name given in the linker script.
- //
- // If an "invalid ELF header" error occurs, it is assumed that the
- // .so file contains a linker script instead of ELF object code.
- // In this case, the code looks for the GROUP ( ... ) linker
- // directive. If one is found, the first file name inside the
- // parentheses is treated as the name of a dynamic library and the
- // code attempts to dlopen that file. If this is also unsuccessful,
- // an error message is returned.
-
-#define NMATCH 5
- regmatch_t match[NMATCH];
- FILE* fp;
- size_t match_length;
-#define MAXLINE 1000
- char line[MAXLINE];
- int result;
-
- // see if the error message is due to an invalid ELF header
- IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg));
- result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0);
- IF_DEBUG(linker, debugBelch("result = %i\n", result));
- if (result == 0) {
- // success -- try to read the named file as a linker script
- match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so),
- MAXLINE-1);
- strncpy(line, (*errmsg+(match[1].rm_so)),match_length);
- line[match_length] = '\0'; // make sure string is null-terminated
- IF_DEBUG(linker, debugBelch("file name = '%s'\n", line));
- if ((fp = __rts_fopen(line, "r")) == NULL) {
- RELEASE_LOCK(&linker_mutex);
- // return original error if open fails
- return NULL;
- }
- // try to find a GROUP or INPUT ( ... ) command
- while (fgets(line, MAXLINE, fp) != NULL) {
- IF_DEBUG(linker, debugBelch("input line = %s", line));
- if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
- // success -- try to dlopen the first named file
- IF_DEBUG(linker, debugBelch("match%s\n",""));
- line[match[2].rm_eo] = '\0';
- stgFree((void*)*errmsg); // Free old message before creating new one
- r = loadNativeObj_ELF(line+match[2].rm_so, errmsg);
- break;
- }
- // if control reaches here, no GROUP or INPUT ( ... ) directive
- // was found and the original error message is returned to the
- // caller
- }
- fclose(fp);
+#if defined(OBJFORMAT_ELF)
+ if (!r) {
+ // Check if native object may be a linker script and try loading a native
+ // object from it
+ r = loadNativeObjFromLinkerScript_ELF(errmsg);
}
+#endif
RELEASE_LOCK(&linker_mutex);
return r;
=====================================
rts/LinkerInternals.h
=====================================
@@ -412,10 +412,6 @@ extern Elf_Word shndx_table_uninit_label;
#if defined(THREADED_RTS)
extern Mutex linker_mutex;
-
-#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
-extern Mutex dl_mutex;
-#endif
#endif /* THREADED_RTS */
/* Type of an initializer */
=====================================
rts/include/rts/Linker.h
=====================================
@@ -93,7 +93,7 @@ HsInt unloadNativeObj( void *handle );
void *lookupSymbolInNativeObj(void *handle, const char *symbol_name);
/* load a dynamic library */
-void *addDLL(pathchar* dll_name, const char **errmsg);
+const char *addDLL(pathchar* dll_name);
void *lookupSymbolInDLL(void *handle, const char *symbol_name);
=====================================
rts/linker/Elf.c
=====================================
@@ -2069,193 +2069,6 @@ int ocRunFini_ELF( ObjectCode *oc )
return true;
}
-/*
- * Shared object loading
- */
-
-#if defined(HAVE_DLINFO)
-struct piterate_cb_info {
- ObjectCode *nc;
- void *l_addr; /* base virtual address of the loaded code */
-};
-
-static int loadNativeObjCb_(struct dl_phdr_info *info,
- size_t _size STG_UNUSED, void *data) {
- struct piterate_cb_info *s = (struct piterate_cb_info *) data;
-
- // This logic mimicks _dl_addr_inside_object from glibc
- // For reference:
- // int
- // internal_function
- // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr)
- // {
- // int n = l->l_phnum;
- // const ElfW(Addr) reladdr = addr - l->l_addr;
- //
- // while (--n >= 0)
- // if (l->l_phdr[n].p_type == PT_LOAD
- // && reladdr - l->l_phdr[n].p_vaddr >= 0
- // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz)
- // return 1;
- // return 0;
- // }
-
- if ((void*) info->dlpi_addr == s->l_addr) {
- int n = info->dlpi_phnum;
- while (--n >= 0) {
- if (info->dlpi_phdr[n].p_type == PT_LOAD) {
- NativeCodeRange* ncr =
- stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_");
- ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr);
- ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz);
-
- ncr->next = s->nc->nc_ranges;
- s->nc->nc_ranges = ncr;
- }
- }
- }
- return 0;
-}
-#endif /* defined(HAVE_DLINFO) */
-
-static void copyErrmsg(char** errmsg_dest, char* errmsg) {
- if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error";
- *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF");
- strcpy(*errmsg_dest, errmsg);
-}
-
-// need dl_mutex
-void freeNativeCode_ELF (ObjectCode *nc) {
- dlclose(nc->dlopen_handle);
-
- NativeCodeRange *ncr = nc->nc_ranges;
- while (ncr) {
- NativeCodeRange* last_ncr = ncr;
- ncr = ncr->next;
- stgFree(last_ncr);
- }
-}
-
-void * loadNativeObj_ELF (pathchar *path, char **errmsg)
-{
- ObjectCode* nc;
- void *hdl, *retval;
-
- IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path));
-
- retval = NULL;
- ACQUIRE_LOCK(&dl_mutex);
-
- // When dlopen() loads a profiled dynamic library, it calls the
- // ctors which will call registerCcsList() to append the defined
- // CostCentreStacks to CCS_LIST. This execution path starting from
- // addDLL() was only protected by dl_mutex previously. However,
- // another thread may be doing other things with the RTS linker
- // that transitively calls refreshProfilingCCSs() which also
- // accesses CCS_LIST, and those execution paths are protected by
- // linker_mutex. So there's a risk of data race that may lead to
- // segfaults (#24423), and we need to ensure the ctors are also
- // protected by ccs_mutex.
-#if defined(PROFILING)
- ACQUIRE_LOCK(&ccs_mutex);
-#endif
- // ROMES:TODO: The above comment suggests the data race is caused by the two
- // concurrent paths being locked by different mutexes (dl_mutex vs
- // linker_mutex), but it seems that loadNativeObj will obtain a lock on
- // linker_mutex before proceeding to here (in loadNativeObj_ELF) where it
- // will obtain a lock on dl_mutex). But ccs_mutex seems like something
- // else entirely?
-
- /* If we load the same object multiple times, just return the
- * already-loaded handle. Note that this is broken if unloadNativeObj
- * is used, as we don’t do any reference counting; see #24345.
- */
- ObjectCode *existing_oc = lookupObjectByPath(path);
- if (existing_oc && existing_oc->status != OBJECT_UNLOADED) {
- if (existing_oc->type == DYNAMIC_OBJECT) {
- retval = existing_oc->dlopen_handle;
- goto success;
- }
- copyErrmsg(errmsg, "loadNativeObj_ELF: already loaded as non-dynamic object");
- goto dlopen_fail;
- }
-
- nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0);
-
- foreignExportsLoadingObject(nc);
- // ROMES:TODO: We previously did RTLD_LAZY in addDLL, but now we do RTLD_NOW. What's the diff?
- // hdl = dlopen(dll_name, RTLD_LAZY|RTLD_LOCAL);
- hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */
- nc->dlopen_handle = hdl;
- nc->status = OBJECT_READY;
- foreignExportsFinishedLoadingObject();
-
- // ROMES:TODO: Could it make sense to do this profiling lock and unlock in foreignExportsLoadingObject/foreignExportsFinishedLoadingObject
-#if defined(PROFILING)
- RELEASE_LOCK(&ccs_mutex);
-#endif
-
- if (hdl == NULL) {
- /* dlopen failed; save the message in errmsg */
- copyErrmsg(errmsg, dlerror());
- goto dlopen_fail;
- }
-
-#if defined(HAVE_DLINFO)
- struct link_map *map;
- if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) {
- /* dlinfo failed; save the message in errmsg */
- copyErrmsg(errmsg, dlerror());
- goto dlinfo_fail;
- }
-
- hdl = NULL; // pass handle ownership to nc
-
- struct piterate_cb_info piterate_info = {
- .nc = nc,
- .l_addr = (void *) map->l_addr
- };
- dl_iterate_phdr(loadNativeObjCb_, &piterate_info);
- if (!nc->nc_ranges) {
- copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj");
- goto dl_iterate_phdr_fail;
- }
- nc->unloadable = true;
-#else
- nc->nc_ranges = NULL;
- nc->unloadable = false;
-#endif /* defined (HAVE_DLINFO) */
-
- insertOCSectionIndices(nc);
-
- nc->next_loaded_object = loaded_objects;
- loaded_objects = nc;
-
- retval = nc->dlopen_handle;
-
-#if defined(PROFILING)
- // collect any new cost centres that were defined in the loaded object.
- refreshProfilingCCSs();
-#endif
-
- goto success;
-
-dl_iterate_phdr_fail:
- // already have dl_mutex
- freeNativeCode_ELF(nc);
-dlinfo_fail:
- if (hdl) dlclose(hdl);
-dlopen_fail:
-success:
-
- RELEASE_LOCK(&dl_mutex);
-
- IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval));
-
- return retval;
-}
-
-
/*
* PowerPC & X86_64 ELF specifics
*/
@@ -2305,4 +2118,70 @@ int ocAllocateExtras_ELF( ObjectCode *oc )
#endif /* NEED_SYMBOL_EXTRAS */
+void * loadNativeObjFromLinkerScript_ELF(char **errmsg)
+{
+ // GHC #2615
+ // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so)
+ // contain linker scripts rather than ELF-format object code. This
+ // code handles the situation by recognizing the real object code
+ // file name given in the linker script.
+ //
+ // If an "invalid ELF header" error occurs, it is assumed that the
+ // .so file contains a linker script instead of ELF object code.
+ // In this case, the code looks for the GROUP ( ... ) linker
+ // directive. If one is found, the first file name inside the
+ // parentheses is treated as the name of a dynamic library and the
+ // code attempts to dlopen that file. If this is also unsuccessful,
+ // an error message is returned.
+
+#define NMATCH 5
+ regmatch_t match[NMATCH];
+ FILE* fp;
+ size_t match_length;
+#define MAXLINE 1000
+ char line[MAXLINE];
+ int result;
+ void* r = NULL;
+
+ ASSERT_LOCK_HELD(&linker_mutex)
+
+ // see if the error message is due to an invalid ELF header
+ IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg));
+ result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0);
+ IF_DEBUG(linker, debugBelch("result = %i\n", result));
+ if (result == 0) {
+ // success -- try to read the named file as a linker script
+ match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so),
+ MAXLINE-1);
+ strncpy(line, (*errmsg+(match[1].rm_so)),match_length);
+ line[match_length] = '\0'; // make sure string is null-terminated
+ IF_DEBUG(linker, debugBelch("file name = '%s'\n", line));
+ if ((fp = __rts_fopen(line, "r")) == NULL) {
+ // return original error if open fails
+ return NULL;
+ }
+ // try to find a GROUP or INPUT ( ... ) command
+ while (fgets(line, MAXLINE, fp) != NULL) {
+ IF_DEBUG(linker, debugBelch("input line = %s", line));
+ if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
+ // success -- try to dlopen the first named file
+ IF_DEBUG(linker, debugBelch("match%s\n",""));
+ line[match[2].rm_eo] = '\0';
+ stgFree((void*)*errmsg); // Free old message before creating new one
+ // ROMES:TODO: NO GOOD, this is almost recursive? no, as long we
+ // move the loadNativeObj_ELF to a shared impl
+ r = loadNativeObj_POSIX(line+match[2].rm_so, errmsg);
+ break;
+ }
+ // if control reaches here, no GROUP or INPUT ( ... ) directive
+ // was found and the original error message is returned to the
+ // caller
+ }
+ fclose(fp);
+ }
+
+ return r;
+}
+
+
#endif /* elf */
=====================================
rts/linker/Elf.h
=====================================
@@ -14,7 +14,6 @@ int ocResolve_ELF ( ObjectCode* oc );
int ocRunInit_ELF ( ObjectCode* oc );
int ocRunFini_ELF ( ObjectCode* oc );
int ocAllocateExtras_ELF ( ObjectCode *oc );
-void freeNativeCode_ELF ( ObjectCode *nc );
-void *loadNativeObj_ELF ( pathchar *path, char **errmsg );
+void *loadNativeObjFromLinkerScript_ELF( char **errmsg );
#include "EndPrivate.h"
=====================================
rts/linker/LoadNativeObjPosix.c
=====================================
@@ -0,0 +1,211 @@
+#include "CheckUnload.h"
+#include "ForeignExports.h"
+#include "LinkerInternals.h"
+#include "Rts.h"
+#include "RtsUtils.h"
+#include "Profiling.h"
+
+#include "linker/LoadNativeObjPosix.h"
+
+#if defined(HAVE_DLFCN_H)
+#include <dlfcn.h>
+#endif
+
+#include <string.h>
+
+#if defined(THREADED_RTS)
+extern Mutex linker_mutex;
+#endif
+
+/*
+ * Shared object loading
+ */
+
+#if defined(HAVE_DLINFO)
+struct piterate_cb_info {
+ ObjectCode *nc;
+ void *l_addr; /* base virtual address of the loaded code */
+};
+
+static int loadNativeObjCb_(struct dl_phdr_info *info,
+ size_t _size STG_UNUSED, void *data) {
+ struct piterate_cb_info *s = (struct piterate_cb_info *) data;
+
+ // This logic mimicks _dl_addr_inside_object from glibc
+ // For reference:
+ // int
+ // internal_function
+ // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr)
+ // {
+ // int n = l->l_phnum;
+ // const ElfW(Addr) reladdr = addr - l->l_addr;
+ //
+ // while (--n >= 0)
+ // if (l->l_phdr[n].p_type == PT_LOAD
+ // && reladdr - l->l_phdr[n].p_vaddr >= 0
+ // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz)
+ // return 1;
+ // return 0;
+ // }
+
+ if ((void*) info->dlpi_addr == s->l_addr) {
+ int n = info->dlpi_phnum;
+ while (--n >= 0) {
+ if (info->dlpi_phdr[n].p_type == PT_LOAD) {
+ NativeCodeRange* ncr =
+ stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_");
+ ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr);
+ ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz);
+
+ ncr->next = s->nc->nc_ranges;
+ s->nc->nc_ranges = ncr;
+ }
+ }
+ }
+ return 0;
+}
+#endif /* defined(HAVE_DLINFO) */
+
+static void copyErrmsg(char** errmsg_dest, char* errmsg) {
+ if (errmsg == NULL) errmsg = "loadNativeObj_POSIX: unknown error";
+ *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_POSIX");
+ strcpy(*errmsg_dest, errmsg);
+}
+
+void freeNativeCode_POSIX (ObjectCode *nc) {
+ ASSERT_LOCK_HELD(&linker_mutex);
+
+ dlclose(nc->dlopen_handle);
+
+ NativeCodeRange *ncr = nc->nc_ranges;
+ while (ncr) {
+ NativeCodeRange* last_ncr = ncr;
+ ncr = ncr->next;
+ stgFree(last_ncr);
+ }
+}
+
+void * loadNativeObj_POSIX (pathchar *path, char **errmsg)
+{
+ ObjectCode* nc;
+ void *hdl, *retval;
+
+ ASSERT_LOCK_HELD(&linker_mutex);
+
+ IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX %" PATH_FMT "\n", path));
+
+ retval = NULL;
+
+
+ /* If we load the same object multiple times, just return the
+ * already-loaded handle. Note that this is broken if unloadNativeObj
+ * is used, as we don’t do any reference counting; see #24345.
+ */
+ ObjectCode *existing_oc = lookupObjectByPath(path);
+ if (existing_oc && existing_oc->status != OBJECT_UNLOADED) {
+ if (existing_oc->type == DYNAMIC_OBJECT) {
+ retval = existing_oc->dlopen_handle;
+ goto success;
+ }
+ copyErrmsg(errmsg, "loadNativeObj_POSIX: already loaded as non-dynamic object");
+ goto dlopen_fail;
+ }
+
+ nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0);
+
+ foreignExportsLoadingObject(nc);
+
+ // When dlopen() loads a profiled dynamic library, it calls the ctors which
+ // will call registerCcsList() to append the defined CostCentreStacks to
+ // CCS_LIST. However, another thread may be doing other things with the RTS
+ // linker that transitively calls refreshProfilingCCSs() which also accesses
+ // CCS_LIST. So there's a risk of data race that may lead to segfaults
+ // (#24423), and we need to ensure the ctors are also protected by
+ // ccs_mutex.
+#if defined(PROFILING)
+ ACQUIRE_LOCK(&ccs_mutex);
+#endif
+
+ // If we HAVE_DLINFO, we use RTLD_NOW rather than RTLD_LAZY because we want
+ // to learn eagerly about all external functions. Otherwise, there is no
+ // additional advantage to being eager, so it is better to be lazy and only bind
+ // functions when needed for better performance.
+ int dlopen_mode;
+#if defined(HAVE_DLINFO)
+ dlopen_mode = RTLD_NOW;
+#else
+ dlopen_mode = RTLD_LAZY;
+#endif
+
+ hdl = dlopen(path, dlopen_mode|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */
+ nc->dlopen_handle = hdl;
+ nc->status = OBJECT_READY;
+
+#if defined(PROFILING)
+ RELEASE_LOCK(&ccs_mutex);
+#endif
+
+ foreignExportsFinishedLoadingObject();
+
+ if (hdl == NULL) {
+ /* dlopen failed; save the message in errmsg */
+ copyErrmsg(errmsg, dlerror());
+ goto dlopen_fail;
+ }
+
+#if defined(HAVE_DLINFO)
+ struct link_map *map;
+ if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) {
+ /* dlinfo failed; save the message in errmsg */
+ copyErrmsg(errmsg, dlerror());
+ goto dlinfo_fail;
+ }
+
+ hdl = NULL; // pass handle ownership to nc
+
+ struct piterate_cb_info piterate_info = {
+ .nc = nc,
+ .l_addr = (void *) map->l_addr
+ };
+ dl_iterate_phdr(loadNativeObjCb_, &piterate_info);
+ if (!nc->nc_ranges) {
+ copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj");
+ goto dl_iterate_phdr_fail;
+ }
+ nc->unloadable = true;
+#else
+ nc->nc_ranges = NULL;
+ nc->unloadable = false;
+#endif /* defined (HAVE_DLINFO) */
+
+ insertOCSectionIndices(nc);
+
+ nc->next_loaded_object = loaded_objects;
+ loaded_objects = nc;
+
+ retval = nc->dlopen_handle;
+
+#if defined(PROFILING)
+ // collect any new cost centres that were defined in the loaded object.
+ refreshProfilingCCSs();
+#endif
+
+ goto success;
+
+#if defined(HAVE_DLINFO)
+dl_iterate_phdr_fail:
+#endif
+ freeNativeCode_POSIX(nc);
+#if defined(HAVE_DLINFO)
+dlinfo_fail:
+#endif
+ if (hdl) dlclose(hdl);
+dlopen_fail:
+success:
+
+ IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX result=%p\n", retval));
+
+ return retval;
+}
+
+
=====================================
rts/linker/LoadNativeObjPosix.h
=====================================
@@ -0,0 +1,11 @@
+#pragma once
+
+#include "Rts.h"
+#include "LinkerInternals.h"
+
+#include "BeginPrivate.h"
+
+void freeNativeCode_POSIX ( ObjectCode *nc );
+void *loadNativeObj_POSIX ( pathchar *path, char **errmsg );
+
+#include "EndPrivate.h"
=====================================
rts/linker/PEi386.c
=====================================
@@ -1865,7 +1865,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
if (result != NULL || dllInstance == 0) {
errorBelch("Could not load `%s'. Reason: %s\n",
(char*)dllName, result);
- // ROMES:QUESTION: Leaks `result`?
+ stgFree(result);
return false;
}
=====================================
rts/rts.cabal
=====================================
@@ -458,6 +458,7 @@ library
linker/Elf.c
linker/InitFini.c
linker/LoadArchive.c
+ linker/LoadNativeObjPosix.c
linker/M32Alloc.c
linker/MMap.c
linker/MachO.c
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4c9d36adcd528ca9d0308ed12b121325977a181d...d408a07a0b5e9888d1c33a7a202880c06869b317
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4c9d36adcd528ca9d0308ed12b121325977a181d...d408a07a0b5e9888d1c33a7a202880c06869b317
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240319/dffca74f/attachment-0001.html>
More information about the ghc-commits
mailing list