#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include <string.h>
#include "libguile/_scm.h"
#include "libguile/strings.h"
#include "libguile/gc.h"
#include "libguile/dynl.h"
#include "libguile/dynwind.h"
#include "libguile/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;
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);
if (head != NULL)
{
extension_t *ext;
char *clib, *cinit;
int found = 0;
scm_dynwind_begin (0);
clib = scm_to_locale_string (lib);
scm_dynwind_free (clib);
cinit = scm_to_locale_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;
}
#if HAVE_MODULES
scm_dynamic_call (init, scm_dynamic_link (lib));
#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_locale_string (lib), scm_from_locale_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 "libguile/extensions.x"
}