mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-07-03 16:20:39 +02:00
Replace ltdl function calls with gmodule
* dynl.c (LT_PATHSEP_CHAR, LT_DIRSEP_CHAR): define locally (sysdep_dynl_link, sysdep_dynl_unlink, sysdep_dynl_value) (sysdep_dynl_init): replace ltdl funtion calls with g_module functions
This commit is contained in:
parent
8c451ec2dd
commit
f6373cf69f
1 changed files with 57 additions and 57 deletions
112
libguile/dynl.c
112
libguile/dynl.c
|
@ -1,6 +1,6 @@
|
||||||
/* dynl.c - dynamic linking
|
/* dynl.c - dynamic linking
|
||||||
|
|
||||||
Copyright 1990-2003,2008-2011,2017-2018
|
Copyright 1990-2003,2008-2011,2017-2018,2020
|
||||||
Free Software Foundation, Inc.
|
Free Software Foundation, Inc.
|
||||||
|
|
||||||
This file is part of Guile.
|
This file is part of Guile.
|
||||||
|
@ -50,6 +50,13 @@
|
||||||
|
|
||||||
#include "dynl.h"
|
#include "dynl.h"
|
||||||
|
|
||||||
|
#ifdef _WIN32
|
||||||
|
#define LT_PATHSEP_CHAR ';'
|
||||||
|
#define LT_DIRSEP_CHAR '\\'
|
||||||
|
#else
|
||||||
|
#define LT_PATHSEP_CHAR ':'
|
||||||
|
#define LT_DIRSEP_CHAR '/'
|
||||||
|
#endif
|
||||||
|
|
||||||
/* From the libtool manual: "Note that libltdl is not threadsafe,
|
/* From the libtool manual: "Note that libltdl is not threadsafe,
|
||||||
i.e. a multithreaded application has to use a mutex for libltdl.".
|
i.e. a multithreaded application has to use a mutex for libltdl.".
|
||||||
|
@ -62,66 +69,62 @@ static char *system_extensions_path;
|
||||||
static void *
|
static void *
|
||||||
sysdep_dynl_link (const char *fname, const char *subr)
|
sysdep_dynl_link (const char *fname, const char *subr)
|
||||||
{
|
{
|
||||||
lt_dlhandle handle;
|
GModule *handle;
|
||||||
|
|
||||||
/* Try the literal filename first or, if NULL, the program itself */
|
/* Try the literal filename first or, if NULL, the program itself */
|
||||||
handle = lt_dlopen (fname);
|
handle = g_module_open (fname, 0);
|
||||||
if (handle == NULL)
|
|
||||||
|
if (handle == NULL
|
||||||
|
#ifdef LT_DIRSEP_CHAR
|
||||||
|
&& strchr (fname, LT_DIRSEP_CHAR) == NULL
|
||||||
|
#endif
|
||||||
|
&& strchr (fname, '/') == NULL)
|
||||||
{
|
{
|
||||||
handle = lt_dlopenext (fname);
|
/* FNAME contains no directory separators and was not in the
|
||||||
|
usual library search paths, so now we search for it in
|
||||||
|
SYSTEM_EXTENSIONS_PATH. */
|
||||||
|
char *fname_attempt
|
||||||
|
= scm_gc_malloc_pointerless (strlen (system_extensions_path)
|
||||||
|
+ strlen (fname) + 2,
|
||||||
|
"dynl fname_attempt");
|
||||||
|
char *path; /* remaining path to search */
|
||||||
|
char *end; /* end of current path component */
|
||||||
|
char *s;
|
||||||
|
|
||||||
if (handle == NULL
|
/* Iterate over the components of SYSTEM_EXTENSIONS_PATH */
|
||||||
#ifdef LT_DIRSEP_CHAR
|
for (path = system_extensions_path;
|
||||||
&& strchr (fname, LT_DIRSEP_CHAR) == NULL
|
*path != '\0';
|
||||||
#endif
|
path = (*end == '\0') ? end : (end + 1))
|
||||||
&& strchr (fname, '/') == NULL)
|
|
||||||
{
|
{
|
||||||
/* FNAME contains no directory separators and was not in the
|
/* Find end of path component */
|
||||||
usual library search paths, so now we search for it in
|
end = strchr (path, LT_PATHSEP_CHAR);
|
||||||
SYSTEM_EXTENSIONS_PATH. */
|
if (end == NULL)
|
||||||
char *fname_attempt
|
end = strchr (path, '\0');
|
||||||
= scm_gc_malloc_pointerless (strlen (system_extensions_path)
|
|
||||||
+ strlen (fname) + 2,
|
|
||||||
"dynl fname_attempt");
|
|
||||||
char *path; /* remaining path to search */
|
|
||||||
char *end; /* end of current path component */
|
|
||||||
char *s;
|
|
||||||
|
|
||||||
/* Iterate over the components of SYSTEM_EXTENSIONS_PATH */
|
/* Skip empty path components */
|
||||||
for (path = system_extensions_path;
|
if (path == end)
|
||||||
*path != '\0';
|
continue;
|
||||||
path = (*end == '\0') ? end : (end + 1))
|
|
||||||
{
|
|
||||||
/* Find end of path component */
|
|
||||||
end = strchr (path, LT_PATHSEP_CHAR);
|
|
||||||
if (end == NULL)
|
|
||||||
end = strchr (path, '\0');
|
|
||||||
|
|
||||||
/* Skip empty path components */
|
/* Construct FNAME_ATTEMPT, starting with path component */
|
||||||
if (path == end)
|
s = fname_attempt;
|
||||||
continue;
|
memcpy (s, path, end - path);
|
||||||
|
s += end - path;
|
||||||
|
|
||||||
/* Construct FNAME_ATTEMPT, starting with path component */
|
/* Append directory separator, but avoid duplicates */
|
||||||
s = fname_attempt;
|
if (s[-1] != '/'
|
||||||
memcpy (s, path, end - path);
|
|
||||||
s += end - path;
|
|
||||||
|
|
||||||
/* Append directory separator, but avoid duplicates */
|
|
||||||
if (s[-1] != '/'
|
|
||||||
#ifdef LT_DIRSEP_CHAR
|
#ifdef LT_DIRSEP_CHAR
|
||||||
&& s[-1] != LT_DIRSEP_CHAR
|
&& s[-1] != LT_DIRSEP_CHAR
|
||||||
#endif
|
#endif
|
||||||
)
|
)
|
||||||
*s++ = '/';
|
*s++ = '/';
|
||||||
|
|
||||||
/* Finally, append FNAME (including null terminator) */
|
/* Finally, append FNAME (including null terminator) */
|
||||||
strcpy (s, fname);
|
strcpy (s, fname);
|
||||||
|
|
||||||
/* Try to load it, and terminate the search if successful */
|
/* Try to load it, and terminate the search if successful */
|
||||||
handle = lt_dlopenext (fname_attempt);
|
handle = g_module_open (fname_attempt, 0);
|
||||||
if (handle != NULL)
|
if (handle != NULL)
|
||||||
break;
|
break;
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -131,7 +134,7 @@ sysdep_dynl_link (const char *fname, const char *subr)
|
||||||
SCM msg;
|
SCM msg;
|
||||||
|
|
||||||
fn = fname != NULL ? scm_from_locale_string (fname) : SCM_BOOL_F;
|
fn = fname != NULL ? scm_from_locale_string (fname) : SCM_BOOL_F;
|
||||||
msg = scm_from_locale_string (lt_dlerror ());
|
msg = scm_from_locale_string (g_module_error ());
|
||||||
scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
|
scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -141,9 +144,9 @@ sysdep_dynl_link (const char *fname, const char *subr)
|
||||||
static void
|
static void
|
||||||
sysdep_dynl_unlink (void *handle, const char *subr)
|
sysdep_dynl_unlink (void *handle, const char *subr)
|
||||||
{
|
{
|
||||||
if (lt_dlclose ((lt_dlhandle) handle))
|
if (g_module_close ((GModule *) handle))
|
||||||
{
|
{
|
||||||
scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);
|
scm_misc_error (subr, (char *) g_module_error (), SCM_EOL);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -152,8 +155,7 @@ sysdep_dynl_value (const char *symb, void *handle, const char *subr)
|
||||||
{
|
{
|
||||||
void *fptr;
|
void *fptr;
|
||||||
|
|
||||||
fptr = lt_dlsym ((lt_dlhandle) handle, symb);
|
if (!g_module_symbol ((GModule *) handle, symb, &fptr))
|
||||||
if (!fptr)
|
|
||||||
scm_misc_error (subr, "Symbol not found: ~a",
|
scm_misc_error (subr, "Symbol not found: ~a",
|
||||||
scm_list_1 (scm_from_locale_string (symb)));
|
scm_list_1 (scm_from_locale_string (symb)));
|
||||||
return fptr;
|
return fptr;
|
||||||
|
@ -164,8 +166,6 @@ sysdep_dynl_init ()
|
||||||
{
|
{
|
||||||
char *env;
|
char *env;
|
||||||
|
|
||||||
lt_dlinit ();
|
|
||||||
|
|
||||||
/* Initialize 'system_extensions_path' from
|
/* Initialize 'system_extensions_path' from
|
||||||
$GUILE_SYSTEM_EXTENSIONS_PATH, or if that's not set:
|
$GUILE_SYSTEM_EXTENSIONS_PATH, or if that's not set:
|
||||||
<SCM_LIB_DIR> <LT_PATHSEP_CHAR> <SCM_EXTENSIONS_DIR>.
|
<SCM_LIB_DIR> <LT_PATHSEP_CHAR> <SCM_EXTENSIONS_DIR>.
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue