From 2e26538d6a51bdd6c2e68ad4539ab3750ef8670a Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 22 Jan 2021 16:39:11 +0100 Subject: Replace libltdl with raw dlopen, dlsym * NEWS: Update. * am/bootstrap.am (SOURCES): * module/Makefile.am (SOURCES): Add system/foreign-library.scm. * configure.ac: Replace ltdl check with -ldl check. * libguile/dynl.c: Rewrite to just expose core dlopen / dlsym / etc to a helper Scheme module. (scm_dynamic_link, scm_dynamic_pointer, scm_dynamic_function) (scm_dynamic_object_p, scm_dynamic_call): Rewrite in terms of (system foreign-library). * libguile/extensions.c (load_extension): Avoid scm_dynamic_call. * module/system/foreign-library.scm: New file. * module/oop/goops.scm (): Hackily export instead of a class here. * doc/ref/api-foreign.texi (Foreign Function Interface): Rewrite to only document the new interfaces. Eventually we will deprecate dynamic-link and friends. * doc/ref/guile.texi (API Reference): Move Foreign Objects after Foreign Function Interface. Seems there should be some closer relationship but this will do for now. * doc/ref/tour.texi (Putting Extensions into Modules): * doc/ref/libguile-parallel.texi (Parallel Installations): Update for rename of Modules and Extensions to Foreign Extensions. * libguile/deprecated.h: * libguile/deprecated.c (scm_dynamic_unlink): Deprecate. * libguile/guile.c: Remove ltdl include. * test-suite/tests/foreign.test: Update tests to use new API, and update error expectations. --- libguile/deprecated.c | 17 +- libguile/deprecated.h | 4 +- libguile/dynl.c | 427 ++++++++++++++------------------------------------ libguile/dynl.h | 9 +- libguile/extensions.c | 7 +- libguile/guile.c | 3 +- 6 files changed, 144 insertions(+), 323 deletions(-) (limited to 'libguile') diff --git a/libguile/deprecated.c b/libguile/deprecated.c index fcc4e8343..e4909dfc6 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -1,4 +1,4 @@ -/* Copyright 2003-2004,2006,2008-2018,2020 +/* Copyright 2003-2004,2006,2008-2018,2020,2021 Free Software Foundation, Inc. This file is part of Guile. @@ -31,7 +31,9 @@ #include "boolean.h" #include "bitvectors.h" #include "deprecation.h" +#include "dynl.h" #include "eval.h" +#include "foreign.h" #include "gc.h" #include "gsubr.h" #include "modules.h" @@ -599,6 +601,19 @@ scm_copy_tree (SCM obj) } + + +SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0, (SCM obj), "") +#define FUNC_NAME s_scm_dynamic_unlink +{ + scm_c_issue_deprecation_warning + ("scm_dynamic_unlink has no effect and is deprecated. Unloading " + "shared libraries is no longer supported."); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + + void diff --git a/libguile/deprecated.h b/libguile/deprecated.h index c95f919e5..c68decf74 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -1,7 +1,7 @@ #ifndef SCM_DEPRECATED_H #define SCM_DEPRECATED_H -/* Copyright 2003-2007,2009-2018,2020 +/* Copyright 2003-2007,2009-2018,2020,2021 Free Software Foundation, Inc. This file is part of Guile. @@ -140,6 +140,8 @@ SCM_DEPRECATED SCM scm_make_srcprops (long line, int col, SCM filename, SCM_DEPRECATED SCM scm_copy_tree (SCM obj); +SCM_DEPRECATED SCM scm_dynamic_unlink (SCM obj); + void scm_i_init_deprecated (void); #endif diff --git a/libguile/dynl.c b/libguile/dynl.c index e9c03e95b..8e1cc90d9 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -1,6 +1,6 @@ /* dynl.c - dynamic linking - Copyright 1990-2003,2008-2011,2017-2018 + Copyright 1990-2003,2008-2011,2017-2018,2021 Free Software Foundation, Inc. This file is part of Guile. @@ -28,369 +28,172 @@ # include #endif -#include -#include -#include -#include - -#include +#include +#include "boolean.h" #include "deprecation.h" -#include "dynwind.h" +#include "eval.h" +#include "extensions.h" #include "foreign.h" -#include "gc.h" #include "gsubr.h" -#include "keywords.h" -#include "libpath.h" #include "list.h" -#include "ports.h" -#include "smob.h" +#include "modules.h" +#include "numbers.h" #include "strings.h" #include "threads.h" +#include "variable.h" +#include "version.h" #include "dynl.h" -/* From the libtool manual: "Note that libltdl is not threadsafe, - i.e. a multithreaded application has to use a mutex for libltdl.". - Note: We initialize it as a recursive mutex below. */ -static scm_i_pthread_mutex_t ltdl_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; - -/* LT_PATH_SEP-separated extension library search path, searched last */ -static char *system_extensions_path; - -static void * -sysdep_dynl_link (const char *fname, const char *subr) -{ - lt_dlhandle handle; - - /* Try the literal filename first or, if NULL, the program itself */ - handle = lt_dlopen (fname); - if (handle == NULL) - { - handle = lt_dlopenext (fname); - - if (handle == NULL -#ifdef LT_DIRSEP_CHAR - && strchr (fname, LT_DIRSEP_CHAR) == NULL -#endif - && strchr (fname, '/') == NULL) - { - /* 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; - - /* Iterate over the components of SYSTEM_EXTENSIONS_PATH */ - for (path = system_extensions_path; - *path != '\0'; - 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 */ - if (path == end) - continue; - - /* Construct FNAME_ATTEMPT, starting with path component */ - s = fname_attempt; - memcpy (s, path, end - path); - s += end - path; - - /* Append directory separator, but avoid duplicates */ - if (s[-1] != '/' -#ifdef LT_DIRSEP_CHAR - && s[-1] != LT_DIRSEP_CHAR -#endif - ) - *s++ = '/'; - - /* Finally, append FNAME (including null terminator) */ - strcpy (s, fname); - - /* Try to load it, and terminate the search if successful */ - handle = lt_dlopenext (fname_attempt); - if (handle != NULL) - break; - } - } - } - - if (handle == NULL) - { - SCM fn; - SCM msg; - - fn = fname != NULL ? scm_from_locale_string (fname) : SCM_BOOL_F; - msg = scm_from_locale_string (lt_dlerror ()); - scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg)); - } - - return (void *) handle; -} - -static void -sysdep_dynl_unlink (void *handle, const char *subr) -{ - if (lt_dlclose ((lt_dlhandle) handle)) - { - scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL); - } -} - -static void * -sysdep_dynl_value (const char *symb, void *handle, const char *subr) +static SCM +dlerror_string (const char *fallback) { - void *fptr; - - fptr = lt_dlsym ((lt_dlhandle) handle, symb); - if (!fptr) - scm_misc_error (subr, "Symbol not found: ~a", - scm_list_1 (scm_from_locale_string (symb))); - return fptr; + const char *message = dlerror (); + if (message) + return scm_from_locale_string (message); + return scm_from_utf8_string ("Unknown error"); } -static void -sysdep_dynl_init () -{ - char *env; - - lt_dlinit (); - - /* Initialize 'system_extensions_path' from - $GUILE_SYSTEM_EXTENSIONS_PATH, or if that's not set: - . - - 'lt_dladdsearchdir' can't be used because it is searched before - the system-dependent search path, which is the one 'libtool - --mode=execute -dlopen' fiddles with (info "(libtool) Libltdl - Interface"). See - . - - The environment variables $LTDL_LIBRARY_PATH and $LD_LIBRARY_PATH - can't be used because they would be propagated to subprocesses - which may cause problems for other programs. See - */ - - env = getenv ("GUILE_SYSTEM_EXTENSIONS_PATH"); - if (env) - system_extensions_path = env; - else - { - system_extensions_path - = scm_gc_malloc_pointerless (strlen (SCM_LIB_DIR) - + strlen (SCM_EXTENSIONS_DIR) + 2, - "system_extensions_path"); - sprintf (system_extensions_path, "%s%c%s", - SCM_LIB_DIR, LT_PATHSEP_CHAR, SCM_EXTENSIONS_DIR); - } -} - -scm_t_bits scm_tc16_dynamic_obj; - -#define DYNL_FILENAME SCM_SMOB_OBJECT -#define DYNL_HANDLE(x) ((void *) SCM_SMOB_DATA_2 (x)) -#define SET_DYNL_HANDLE(x, v) (SCM_SET_SMOB_DATA_2 ((x), (scm_t_bits) (v))) - - - -static int -dynl_obj_print (SCM exp, SCM port, scm_print_state *pstate) -{ - scm_puts ("#', port); - return 1; -} - - -SCM_DEFINE (scm_dynamic_link, "dynamic-link", 0, 1, 0, - (SCM filename), - "Find the shared object (shared library) denoted by\n" - "@var{filename} and link it into the running Guile\n" - "application. The returned\n" - "scheme object is a ``handle'' for the library which can\n" - "be passed to @code{dynamic-func}, @code{dynamic-call} etc.\n\n" - "Searching for object files is system dependent. Normally,\n" - "if @var{filename} does have an explicit directory it will\n" - "be searched for in locations\n" - "such as @file{/usr/lib} and @file{/usr/local/lib}.\n\n" - "When @var{filename} is omitted, a @dfn{global symbol handle} is\n" - "returned. This handle provides access to the symbols\n" - "available to the program at run-time, including those exported\n" - "by the program itself and the shared libraries already loaded.\n") -#define FUNC_NAME s_scm_dynamic_link +SCM_DEFINE_STATIC (scm_dlopen, "dlopen", 2, 0, 0, (SCM name, SCM flags), "") +#define FUNC_NAME s_scm_dlopen { void *handle; - char *file; + int c_flags = scm_to_int (flags); - scm_dynwind_begin (0); - scm_i_dynwind_pthread_mutex_lock (<dl_lock); - - if (SCM_UNBNDP (filename)) - file = NULL; + if (scm_is_false (name)) + handle = dlopen (NULL, c_flags); else { - file = scm_to_locale_string (filename); - scm_dynwind_free (file); + char *c_name = scm_to_locale_string (name); + handle = dlopen (c_name, c_flags); + free (c_name); } - handle = sysdep_dynl_link (file, FUNC_NAME); - scm_dynwind_end (); + if (!handle) { + SCM message = dlerror_string ("Unknown error while opening module"); + SCM_MISC_ERROR ("file ~S, message ~S", scm_list_2 (name, message)); + } - SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj, - SCM_UNBNDP (filename) - ? SCM_UNPACK (SCM_BOOL_F) : SCM_UNPACK (filename), - handle); + return scm_from_pointer (handle, NULL); } #undef FUNC_NAME - -SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0, - (SCM obj), - "Return @code{#t} if @var{obj} is a dynamic object handle,\n" - "or @code{#f} otherwise.") -#define FUNC_NAME s_scm_dynamic_object_p +SCM_DEFINE_STATIC (scm_dlclose, "dlclose", 1, 0, 0, (SCM obj), "") +#define FUNC_NAME s_scm_dlclose { - return scm_from_bool (SCM_TYP16_PREDICATE (scm_tc16_dynamic_obj, obj)); -} -#undef FUNC_NAME + void *handle = scm_to_pointer (obj); - -SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0, - (SCM dobj), - "Unlink a dynamic object from the application, if possible. The\n" - "object must have been linked by @code{dynamic-link}, with \n" - "@var{dobj} the corresponding handle. After this procedure\n" - "is called, the handle can no longer be used to access the\n" - "object.") -#define FUNC_NAME s_scm_dynamic_unlink -{ - /*fixme* GC-problem */ - SCM_VALIDATE_SMOB (SCM_ARG1, dobj, dynamic_obj); - - scm_dynwind_begin (0); - scm_i_dynwind_pthread_mutex_lock (<dl_lock); - if (DYNL_HANDLE (dobj) == NULL) { - SCM_MISC_ERROR ("Already unlinked: ~S", scm_list_1 (dobj)); - } else { - sysdep_dynl_unlink (DYNL_HANDLE (dobj), FUNC_NAME); - SET_DYNL_HANDLE (dobj, NULL); + if (dlclose (handle) != 0) { + SCM message = dlerror_string ("Unknown error"); + SCM_MISC_ERROR ("Error closing module: ~S", scm_list_1 (message)); } - scm_dynwind_end (); return SCM_UNSPECIFIED; } #undef FUNC_NAME - -SCM_DEFINE (scm_dynamic_pointer, "dynamic-pointer", 2, 0, 0, - (SCM name, SCM dobj), - "Return a ``wrapped pointer'' to the symbol @var{name}\n" - "in the shared object referred to by @var{dobj}. The returned\n" - "pointer points to a C object.\n\n" - "Regardless whether your C compiler prepends an underscore\n" - "@samp{_} to the global names in a program, you should\n" - "@strong{not} include this underscore in @var{name}\n" - "since it will be added automatically when necessary.") -#define FUNC_NAME s_scm_dynamic_pointer +SCM_DEFINE_STATIC (scm_dlsym, "dlsym", 2, 0, 0, (SCM obj, SCM name), "") +#define FUNC_NAME s_scm_dlsym { - void *val; + void *handle = scm_to_pointer (obj); + char *c_name = scm_to_utf8_string (name); - SCM_VALIDATE_STRING (1, name); - SCM_VALIDATE_SMOB (SCM_ARG2, dobj, dynamic_obj); + void *sym = dlsym (handle, c_name); + free (c_name); - if (DYNL_HANDLE (dobj) == NULL) - SCM_MISC_ERROR ("Already unlinked: ~S", dobj); - else - { - char *chars; - - scm_dynwind_begin (0); - scm_i_dynwind_pthread_mutex_lock (<dl_lock); - chars = scm_to_locale_string (name); - scm_dynwind_free (chars); - val = sysdep_dynl_value (chars, DYNL_HANDLE (dobj), FUNC_NAME); - scm_dynwind_end (); + if (!sym) { + SCM message = dlerror_string ("Unknown error"); + SCM_MISC_ERROR ("Error resolving ~S: ~S", scm_list_2 (name, message)); + } - return scm_from_pointer (val, NULL); - } + return scm_from_pointer (sym, NULL); } #undef FUNC_NAME +#define DEFINE_LAZY_VAR(c_name, mod_name, sym_name) \ + static SCM c_name##_var; \ + static void init_##c_name##_var (void) \ + { \ + c_name##_var = scm_c_public_lookup (mod_name, sym_name); \ + } \ + static SCM c_name (void) \ + { \ + static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; \ + scm_i_pthread_once (&once, init_##c_name##_var); \ + return scm_variable_ref (c_name##_var); \ + } -SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0, - (SCM name, SCM dobj), - "Return a ``handle'' for the function @var{name} in the\n" - "shared object referred to by @var{dobj}. The handle\n" - "can be passed to @code{dynamic-call} to actually\n" - "call the function.\n\n" - "Regardless whether your C compiler prepends an underscore\n" - "@samp{_} to the global names in a program, you should\n" - "@strong{not} include this underscore in @var{name}\n" - "since it will be added automatically when necessary.") -#define FUNC_NAME s_scm_dynamic_func +DEFINE_LAZY_VAR (load_foreign_library, + "system foreign-library", "load-foreign-library"); +DEFINE_LAZY_VAR (foreign_library_p, + "system foreign-library", "foreign-library?"); +DEFINE_LAZY_VAR (foreign_library_pointer, + "system foreign-library", "foreign-library-pointer"); + +SCM +scm_dynamic_link (SCM filename) { - return scm_dynamic_pointer (name, dobj); + return scm_call_1 (load_foreign_library (), filename); } -#undef FUNC_NAME +SCM +scm_dynamic_object_p (SCM obj) +{ + return scm_call_1 (foreign_library_p (), obj); +} -SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0, - (SCM func, SCM dobj), - "Call a C function in a dynamic object. Two styles of\n" - "invocation are supported:\n\n" - "@itemize @bullet\n" - "@item @var{func} can be a function handle returned by\n" - "@code{dynamic-func}. In this case @var{dobj} is\n" - "ignored\n" - "@item @var{func} can be a string with the name of the\n" - "function to call, with @var{dobj} the handle of the\n" - "dynamic object in which to find the function.\n" - "This is equivalent to\n" - "@smallexample\n\n" - "(dynamic-call (dynamic-func @var{func} @var{dobj}) #f)\n" - "@end smallexample\n" - "@end itemize\n\n" - "In either case, the function is passed no arguments\n" - "and its return value is ignored.") -#define FUNC_NAME s_scm_dynamic_call +SCM +scm_dynamic_pointer (SCM name, SCM obj) { - void (*fptr) (void); + return scm_call_2 (foreign_library_pointer (), obj, name); +} - if (scm_is_string (func)) - func = scm_dynamic_func (func, dobj); - SCM_VALIDATE_POINTER (SCM_ARG1, func); +SCM +scm_dynamic_func (SCM name, SCM obj) +{ + return scm_dynamic_pointer (name, obj); +} - fptr = SCM_POINTER_VALUE (func); - fptr (); +SCM +scm_dynamic_call (SCM name, SCM obj) +{ + SCM pointer = scm_dynamic_pointer (name, obj); + void (*f)(void) = SCM_POINTER_VALUE (pointer); + f(); return SCM_UNSPECIFIED; } -#undef FUNC_NAME -void -scm_init_dynamic_linking () +static void +scm_init_system_foreign_library (void *unused) { - scm_tc16_dynamic_obj = scm_make_smob_type ("dynamic-object", 0); - scm_set_smob_print (scm_tc16_dynamic_obj, dynl_obj_print); + scm_c_define ("RTLD_LAZY", scm_from_int (RTLD_LAZY)); + scm_c_define ("RTLD_NOW", scm_from_int (RTLD_NOW)); + scm_c_define ("RTLD_GLOBAL", scm_from_int (RTLD_GLOBAL)); + scm_c_define ("RTLD_LOCAL", scm_from_int (RTLD_LOCAL)); - /* Make LTDL_LOCK recursive so that a pre-unwind handler can still use - 'dynamic-link', as is the case at the REPL. See - . */ - scm_i_pthread_mutex_init (<dl_lock, - scm_i_pthread_mutexattr_recursive); - - sysdep_dynl_init (); #include "dynl.x" } + +void +scm_init_dynamic_linking () +{ + scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, + "scm_init_system_foreign_library", + scm_init_system_foreign_library, + NULL); + + // FIXME: Deprecate all of these, once (system foreign-library) has + // had enough time in the world. + scm_c_define_gsubr + ("dynamic-link", 0, 1, 0, (scm_t_subr) scm_dynamic_link); + scm_c_define_gsubr + ("dynamic-object?", 1, 0, 0, (scm_t_subr) scm_dynamic_object_p); + scm_c_define_gsubr + ("dynamic-func", 2, 0, 0, (scm_t_subr) scm_dynamic_func); + scm_c_define_gsubr + ("dynamic-pointer", 2, 0, 0, (scm_t_subr) scm_dynamic_pointer); + scm_c_define_gsubr + ("dynamic-call", 2, 0, 0, (scm_t_subr) scm_dynamic_call); +} diff --git a/libguile/dynl.h b/libguile/dynl.h index 3178c9a75..dd10bf42a 100644 --- a/libguile/dynl.h +++ b/libguile/dynl.h @@ -1,7 +1,7 @@ #ifndef SCM_DYNL_H #define SCM_DYNL_H -/* Copyright 1996,1998,2000-2001,2006,2008,2010,2018 +/* Copyright 1996,1998,2000-2001,2006,2008,2010,2018,2021 Free Software Foundation, Inc. This file is part of Guile. @@ -27,11 +27,10 @@ SCM_API SCM scm_dynamic_link (SCM fname); -SCM_API SCM scm_dynamic_unlink (SCM dobj); SCM_API SCM scm_dynamic_object_p (SCM obj); -SCM_API SCM scm_dynamic_pointer (SCM name, SCM dobj); -SCM_API SCM scm_dynamic_func (SCM symb, SCM dobj); -SCM_API SCM scm_dynamic_call (SCM symb, SCM dobj); +SCM_API SCM scm_dynamic_pointer (SCM name, SCM obj); +SCM_API SCM scm_dynamic_func (SCM name, SCM obj); +SCM_API SCM scm_dynamic_call (SCM name, SCM obj); SCM_INTERNAL void scm_init_dynamic_linking (void); diff --git a/libguile/extensions.c b/libguile/extensions.c index a094159d4..61c975e16 100644 --- a/libguile/extensions.c +++ b/libguile/extensions.c @@ -1,4 +1,4 @@ -/* Copyright 2001,2002,2004,2006,2009-2011,2018-2019 +/* Copyright 2001,2002,2004,2006,2009-2011,2018-2019,2021 Free Software Foundation, Inc. This file is part of Guile. @@ -27,6 +27,7 @@ #include "dynwind.h" #include "gc.h" #include "gsubr.h" +#include "foreign.h" #include "strings.h" #include "threads.h" @@ -113,7 +114,9 @@ load_extension (SCM lib, SCM init) /* Dynamically link the library. */ #if HAVE_MODULES - scm_dynamic_call (init, scm_dynamic_link (lib)); + SCM pointer = scm_dynamic_pointer (init, scm_dynamic_link (lib)); + void (*f)(void) = scm_to_pointer (pointer); + f (); #else scm_misc_error ("load-extension", "extension ~S:~S not registered and dynamic-link disabled", diff --git a/libguile/guile.c b/libguile/guile.c index ae592ed22..bafe5d66e 100644 --- a/libguile/guile.c +++ b/libguile/guile.c @@ -1,4 +1,4 @@ -/* Copyright 1996-1997,2000-2001,2006,2008,2011,2013,2018 +/* Copyright 1996-1997,2000-2001,2006,2008,2011,2013,2018,2021 Free Software Foundation, Inc. This file is part of Guile. @@ -28,7 +28,6 @@ # include #endif -#include #include #include -- cgit v1.2.3