mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
* 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 (<dynamic-object>): Hackily export <foreign-library> 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.
180 lines
5.2 KiB
C
180 lines
5.2 KiB
C
/* Copyright 2001,2002,2004,2006,2009-2011,2018-2019,2021
|
|
Free Software Foundation, Inc.
|
|
|
|
This file is part of Guile.
|
|
|
|
Guile is free software: you can redistribute it and/or modify it
|
|
under the terms of the GNU Lesser General Public License as published
|
|
by the Free Software Foundation, either version 3 of the License, or
|
|
(at your option) any later version.
|
|
|
|
Guile is distributed in the hope that it will be useful, but WITHOUT
|
|
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
|
|
License for more details.
|
|
|
|
You should have received a copy of the GNU Lesser General Public
|
|
License along with Guile. If not, see
|
|
<https://www.gnu.org/licenses/>. */
|
|
|
|
#ifdef HAVE_CONFIG_H
|
|
# include <config.h>
|
|
#endif
|
|
|
|
#include <string.h>
|
|
|
|
#include "dynl.h"
|
|
#include "dynwind.h"
|
|
#include "gc.h"
|
|
#include "gsubr.h"
|
|
#include "foreign.h"
|
|
#include "strings.h"
|
|
#include "threads.h"
|
|
|
|
#include "extensions.h"
|
|
|
|
|
|
typedef struct extension_t
|
|
{
|
|
struct extension_t *next;
|
|
const char *lib;
|
|
const char *init;
|
|
void (*func)(void *);
|
|
void *data;
|
|
} extension_t;
|
|
|
|
static extension_t *registered_extensions = NULL;
|
|
static scm_i_pthread_mutex_t ext_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
|
|
|
|
/* Register a LIB/INIT pair for use by `scm_load_extension'. LIB is
|
|
allowed to be NULL and then only INIT is used to identify the
|
|
registered entry. This is useful when you don't know the library
|
|
name (which isn't really relevant anyway in a completely linked
|
|
program) and you are sure that INIT is unique (which it must be for
|
|
static linking). Hmm, given this reasoning, what use is LIB
|
|
anyway?
|
|
*/
|
|
|
|
void
|
|
scm_c_register_extension (const char *lib, const char *init,
|
|
void (*func) (void *), void *data)
|
|
{
|
|
extension_t *ext = scm_malloc (sizeof(extension_t));
|
|
if (lib)
|
|
ext->lib = scm_strdup (lib);
|
|
else
|
|
ext->lib = NULL;
|
|
ext->init = scm_strdup (init);
|
|
ext->func = func;
|
|
ext->data = data;
|
|
|
|
scm_i_pthread_mutex_lock (&ext_lock);
|
|
ext->next = registered_extensions;
|
|
registered_extensions = ext;
|
|
scm_i_pthread_mutex_unlock (&ext_lock);
|
|
}
|
|
|
|
static void
|
|
load_extension (SCM lib, SCM init)
|
|
{
|
|
extension_t *head;
|
|
|
|
scm_i_pthread_mutex_lock (&ext_lock);
|
|
head = registered_extensions;
|
|
scm_i_pthread_mutex_unlock (&ext_lock);
|
|
|
|
/* Search the registry. */
|
|
if (head != NULL)
|
|
{
|
|
extension_t *ext;
|
|
char *clib, *cinit;
|
|
int found = 0;
|
|
|
|
scm_dynwind_begin (0);
|
|
|
|
clib = scm_to_utf8_string (lib);
|
|
scm_dynwind_free (clib);
|
|
cinit = scm_to_utf8_string (init);
|
|
scm_dynwind_free (cinit);
|
|
|
|
for (ext = head; ext; ext = ext->next)
|
|
if ((ext->lib == NULL || !strcmp (ext->lib, clib))
|
|
&& !strcmp (ext->init, cinit))
|
|
{
|
|
ext->func (ext->data);
|
|
found = 1;
|
|
break;
|
|
}
|
|
|
|
scm_dynwind_end ();
|
|
|
|
if (found)
|
|
return;
|
|
}
|
|
|
|
/* Dynamically link the library. */
|
|
#if HAVE_MODULES
|
|
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",
|
|
scm_list_2 (init, lib));
|
|
#endif
|
|
}
|
|
|
|
void
|
|
scm_c_load_extension (const char *lib, const char *init)
|
|
{
|
|
load_extension (scm_from_utf8_string (lib), scm_from_utf8_string (init));
|
|
}
|
|
|
|
SCM_DEFINE (scm_load_extension, "load-extension", 2, 0, 0,
|
|
(SCM lib, SCM init),
|
|
"Load and initialize the extension designated by LIB and INIT.\n"
|
|
"When there is no pre-registered function for LIB/INIT, this is\n"
|
|
"equivalent to\n"
|
|
"\n"
|
|
"@lisp\n"
|
|
"(dynamic-call INIT (dynamic-link LIB))\n"
|
|
"@end lisp\n"
|
|
"\n"
|
|
"When there is a pre-registered function, that function is called\n"
|
|
"instead.\n"
|
|
"\n"
|
|
"Normally, there is no pre-registered function. This option exists\n"
|
|
"only for situations where dynamic linking is unavailable or unwanted.\n"
|
|
"In that case, you would statically link your program with the desired\n"
|
|
"library, and register its init function right after Guile has been\n"
|
|
"initialized.\n"
|
|
"\n"
|
|
"LIB should be a string denoting a shared library without any file type\n"
|
|
"suffix such as \".so\". The suffix is provided automatically. It\n"
|
|
"should also not contain any directory components. Libraries that\n"
|
|
"implement Guile Extensions should be put into the normal locations for\n"
|
|
"shared libraries. We recommend to use the naming convention\n"
|
|
"libguile-bla-blum for a extension related to a module `(bla blum)'.\n"
|
|
"\n"
|
|
"The normal way for a extension to be used is to write a small Scheme\n"
|
|
"file that defines a module, and to load the extension into this\n"
|
|
"module. When the module is auto-loaded, the extension is loaded as\n"
|
|
"well. For example,\n"
|
|
"\n"
|
|
"@lisp\n"
|
|
"(define-module (bla blum))\n"
|
|
"\n"
|
|
"(load-extension \"libguile-bla-blum\" \"bla_init_blum\")\n"
|
|
"@end lisp")
|
|
#define FUNC_NAME s_scm_load_extension
|
|
{
|
|
load_extension (lib, init);
|
|
return SCM_UNSPECIFIED;
|
|
}
|
|
#undef FUNC_NAME
|
|
|
|
void
|
|
scm_init_extensions ()
|
|
{
|
|
#include "extensions.x"
|
|
}
|