summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/dynl-dl.c159
-rw-r--r--libguile/dynl-dld.c115
-rw-r--r--libguile/dynl-shl.c130
-rw-r--r--libguile/dynl.c272
-rw-r--r--libguile/dynl.h12
5 files changed, 356 insertions, 332 deletions
diff --git a/libguile/dynl-dl.c b/libguile/dynl-dl.c
index 7899b3245..96a78e44a 100644
--- a/libguile/dynl-dl.c
+++ b/libguile/dynl-dl.c
@@ -45,168 +45,59 @@
Author: Aubrey Jaffer
Modified for libguile by Marius Vollmer */
-#include "_scm.h"
-#include "genio.h"
-#include "smob.h"
-
#include <dlfcn.h>
-#define SHL(obj) ((void*)SCM_CDR(obj))
-
#ifdef RTLD_LAZY /* Solaris 2. */
# define DLOPEN_MODE RTLD_LAZY
#else
# define DLOPEN_MODE 1 /* Thats what it says in the man page. */
#endif
-static scm_sizet frshl SCM_P ((SCM ptr));
-
-static scm_sizet
-frshl (ptr)
- SCM ptr;
-{
-#if 0
- /* Should freeing a shl close and possibly unmap the object file it */
- /* refers to? */
- if (SHL(ptr))
- dlclose (SHL(ptr));
-#endif
- return 0;
-}
-
-static int prinshl SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
-
-static int
-prinshl (exp, port, pstate)
- SCM exp;
- SCM port;
- scm_print_state *pstate;
+static void *
+sysdep_dynl_link (fname, subr)
+ char *fname;
+ char *subr;
{
- scm_gen_puts (scm_regular_string, "#<dynamic-linked ", port);
- scm_intprint (SCM_CDR (exp), 16, port);
- scm_gen_putc ('>', port);
- return 1;
+ void *handle = dlopen (fname, DLOPEN_MODE);
+ if (NULL == handle)
+ scm_misc_error (subr, (char *)dlerror (), SCM_EOL);
+ return handle;
}
-int scm_tc16_shl;
-static scm_smobfuns shlsmob = { scm_mark0, frshl, prinshl };
-
-SCM_PROC (s_dynamic_link, "dynamic-link", 1, 0, 0, scm_dynamic_link);
-
-SCM
-scm_dynamic_link (fname)
- SCM fname;
+static void
+sysdep_dynl_unlink (handle, subr)
+ void *handle;
+ char *subr;
{
- SCM z;
- void *handle;
-
- /* if FALSEP(fname) return fname; XXX - ? */
-
- fname = scm_coerce_rostring (fname, s_dynamic_link, SCM_ARG1);
+ int status;
SCM_DEFER_INTS;
- handle = dlopen (SCM_CHARS (fname), DLOPEN_MODE);
- if (NULL == handle)
- scm_misc_error (s_dynamic_link, (char *)dlerror (), SCM_EOL);
- SCM_NEWCELL (z);
- SCM_SETCHARS (z, handle);
- SCM_SETCAR (z, scm_tc16_shl);
+ status = dlclose (handle);
SCM_ALLOW_INTS;
-
- return z;
+ if(status)
+ scm_misc_error (subr, (char *)dlerror (), SCM_EOL);
}
-
-static void *get_func SCM_P ((void *handle, char *func, char *subr));
-
+
static void *
-get_func (handle, func, subr)
+sysdep_dynl_func (symb, handle, subr)
+ char *symb;
void *handle;
- char *func;
char *subr;
{
void *fptr;
char *err;
- fptr = dlsym (handle, func);
+ SCM_DEFER_INTS;
+ fptr = dlsym (handle, symb);
err = (char *)dlerror ();
+ SCM_ALLOW_INTS;
+
if (!fptr)
scm_misc_error (subr, err? err : "symbol has NULL address", SCM_EOL);
return fptr;
}
-SCM_PROC (s_dynamic_call, "dynamic-call", 2, 0, 0, scm_dynamic_call);
-
-SCM
-scm_dynamic_call (symb, shl)
- SCM symb, shl;
-{
- void (*func) SCM_P ((void)) = 0;
-
- symb = scm_coerce_rostring (symb, s_dynamic_call, SCM_ARG1);
- SCM_ASSERT (SCM_NIMP (shl) && SCM_CAR (shl) == scm_tc16_shl, shl,
- SCM_ARG2, s_dynamic_call);
-
- SCM_DEFER_INTS;
- func = get_func (SHL(shl), SCM_CHARS (symb), s_dynamic_call);
- SCM_ALLOW_INTS;
-
- (*func) ();
-
- return SCM_BOOL_T;
-}
-
-SCM_PROC (s_dynamic_args_call, "dynamic-args-call", 3, 0, 0, scm_dynamic_args_call);
-
-SCM
-scm_dynamic_args_call (symb, shl, args)
- SCM symb, shl, args;
-{
- int i, argc;
- char **argv;
- int (*func) SCM_P ((int argc, char **argv)) = 0;
-
- symb = scm_coerce_rostring (symb, s_dynamic_args_call, SCM_ARG1);
- SCM_ASSERT (SCM_NIMP (shl) && SCM_CAR (shl) == scm_tc16_shl, shl,
- SCM_ARG2, s_dynamic_args_call);
-
- SCM_DEFER_INTS;
- func = get_func (SHL(shl), SCM_CHARS (symb), s_dynamic_args_call);
- argv = scm_make_argv_from_stringlist (args, &argc, s_dynamic_args_call,
- SCM_ARG3);
- SCM_ALLOW_INTS;
-
- i = (*func) (argc, argv);
-
- SCM_DEFER_INTS;
- scm_must_free_argv(argv);
- SCM_ALLOW_INTS;
- return SCM_MAKINUM(0L+i);
-}
-
-SCM_PROC (s_dynamic_unlink, "dynamic-unlink", 1, 0, 0, scm_dynamic_unlink);
-
-SCM
-scm_dynamic_unlink (shl)
- SCM shl;
-{
- int status;
-
- SCM_ASSERT (SCM_NIMP (shl) && SCM_CAR (shl) == scm_tc16_shl, shl,
- SCM_ARG1, s_dynamic_unlink);
-
- SCM_DEFER_INTS;
- status = dlclose (SHL(shl));
- SCM_SETCHARS (shl, NULL);
- SCM_ALLOW_INTS;
-
- if (status)
- scm_misc_error (s_dynamic_unlink, (char *)dlerror (), SCM_EOL);
- return SCM_BOOL_T;
-}
-
-void
-scm_init_dynamic_linking ()
+static void
+sysdep_dynl_init ()
{
- scm_tc16_shl = scm_newsmob (&shlsmob);
-#include "dynl.x"
}
diff --git a/libguile/dynl-dld.c b/libguile/dynl-dld.c
index aba8b93ed..96a51df7a 100644
--- a/libguile/dynl-dld.c
+++ b/libguile/dynl-dld.c
@@ -45,10 +45,6 @@
Author: Aubrey Jaffer
Modified for libguile by Marius Vollmer */
-#include "_scm.h"
-#include "genio.h"
-#include "smob.h"
-
#include "dld.h"
static void listundef SCM_P ((void));
@@ -67,108 +63,55 @@ listundefs ()
free(undefs);
}
-SCM_PROC (s_dynamic_link, "dynamic-link", 1, 0, 0, scm_dynamic_link);
+static void *
+sysdep_dynl_link (fname, subr)
+ char *fname;
+ char *subr;
+{
+ int status;
-SCM
-scm_dynamic_link (fname)
- SCM fname;
+ status = dld_link (fname);
+ if (status)
+ scm_misc_error (subr, dld_strerror (status), SCM_EOL);
+ return fname;
+}
+
+static void
+sysdep_dynl_unlink (handle, subr)
+ void *handle;
+ char *subr;
{
int status;
-
- fname = scm_coerce_rostring (fname, s_dynamic_link, SCM_ARG1);
SCM_DEFER_INTS;
- status = dld_link (SCM_CHARS (fname));
+ status = dld_unlink_by_file ((char *)fname, 1);
SCM_ALLOW_INTS;
if (status)
- scm_misc_error (s_dynamic_link, dld_strerror (status), SCM_EOL);
- return fname;
+ scm_misc_error (s_dynamic_unlink, dld_strerror (status), SCM_EOL);
}
-static void *get_func SCM_P ((char *subr, char *fname));
-
static void *
-get_func (subr, fname)
+sysdep_dynl_func (symb, handle, subr)
+ char *symb;
+ void *handle;
char *subr;
- char *fname;
{
void *func;
+ SCM_DEFER_INTS;
+ func = (void *) dld_get_func (func);
+ if (func == 0)
+ scm_misc_error (subr, dld_strerror (dld_errno), SCM_EOL);
if (!dld_function_executable_p (func)) {
listundefs ();
scm_misc_error (subr, "unresolved symbols remain", SCM_EOL);
}
- func = (void *) dld_get_func (func);
- if (func == 0)
- scm_misc_error (subr, dld_strerror (dld_errno), SCM_EOL);
- return func;
-}
-
-SCM_PROC (s_dynamic_call, "dynamic-call", 2, 0, 0, scm_dynamic_call);
-
-SCM
-scm_dynamic_call (symb, shl)
- SCM symb;
- SCM shl;
-{
- void (*func)() = 0;
-
- symb = scm_coerce_rostring (symb, s_dynamic_call, SCM_ARG1);
-
- SCM_DEFER_INTS;
- func = get_func (s_dynamic_call, SCM_CHARS (symb));
- SCM_ALLOW_INST;
- (*func) ();
- return SCM_BOOL_T;
-}
-
-SCM_PROC (s_dynamic_args_call, "dynamic-args-call", 3, 0, 0, scm_dynamic_args_call);
-
-SCM
-scm_dynamic_args_call (symb, shl, args)
- SCM symb, shl, args;
-{
- int i, argc;
- char **argv;
- int (*func) SCM_P ((int argc, char **argv)) = 0;
-
- symb = scm_coerce_rostring (symb, s_dynamic_args_call, SCM_ARG1);
-
- SCM_DEFER_INTS;
- func = get_func (SCM_CHARS (symb), s_dynamic_args_call);
- argv = scm_make_argv_from_stringlist (args, &argc, s_dynamic_args_call,
- SCM_ARG3);
- SCM_ALLOW_INTS;
-
- i = (*func) (argc, argv);
-
- SCM_DEFER_INTS;
- scm_must_free_argv(argv);
- SCM_ALLOW_INTS;
- return SCM_MAKINUM(0L+i);
-}
-
-SCM_PROC (s_dynamic_unlink, "dynamic-unlink", 1, 0, 0, scm_dynamic_unlink);
-
-SCM
-scm_dynamic_unlink(fname)
- SCM fname;
-{
- int status;
-
- fname = scm_coerce_rostring (fname, s_dynamic_unlink, SCM_ARG1);
-
- SCM_DEFER_INTS;
- status = dld_unlink_by_file (SCM_CHARS (fname), 1);
SCM_ALLOW_INTS;
-
- if (status)
- scm_misc_error (s_dynamic_unlink, dld_strerror (status), SCM_EOL);
- return SCM_BOOL_T;
+ return func;
}
-void
-scm_init_dynamic_linking ()
+static void
+sysdep_dynl_init ()
{
#ifndef RTL
if (!execpath)
@@ -179,8 +122,6 @@ scm_init_dynamic_linking ()
}
#endif
-#include "dynl.x"
-
#ifdef DLD_DYNCM /* XXX - what's this? */
add_feature("dld:dyncm");
#endif
diff --git a/libguile/dynl-shl.c b/libguile/dynl-shl.c
index b8e474484..4612fa9c8 100644
--- a/libguile/dynl-shl.c
+++ b/libguile/dynl-shl.c
@@ -45,128 +45,54 @@
Author: Aubrey Jaffer
Modified for libguile by Marius Vollmer */
-#include "_scm.h"
-#include "genio.h"
-#include "smob.h"
-
#include "dl.h"
-#define SHL(obj) ((shl_t*)SCM_CDR(obj))
-
-static int printshl SCM_P ((SCM exp, SCM port, scm_printstate *pstate));
-
-static int
-prinshl (exp, port, pstate)
- SCM exp;
- SCM port;
- scm_printstate *pstate;
-{
- scm_gen_puts (scm_regular_string, "#<dynamic-linked ", port);
- scm_intprint (SCM_CDR (exp), 16, port);
- scm_gen_putc ('>', port);
- return 1;
-}
-
-int scm_tc16_shl;
-static scm_smobfuns shlsmob = { scm_mark0, scm_free0, prinshl };
-
-SCM_PROC (s_dynamic_link, "dynamic-link", 1, 0, 0, scm_dynamic_link);
-
-SCM
-scm_dynamic_link (fname)
- SCM fname;
+static void *
+sysdep_dynl_link (fname, subr)
+ char *fname;
+ char *subr;
{
- SCM z;
shl_t shl;
- fname = scm_coerce_rostring (fname, s_dynamic_link, SCM_ARG1);
-
- SCM_DEFER_INTS;
- shl = shl_load (SCM_CHARS (fname), BIND_DEFERRED , 0L);
+ shl = shl_load (fname, BIND_DEFERRED , 0L);
if (NULL==shl)
- scm_misc_error (s_dynamic_link, "dynamic linking failed", SCM_EOL);
- SCM_NEWCELL (z);
- SCM_SETCHARS (z, shl);
- SCM_SETCAR (z, scm_tc16_shl);
- SCM_ALLOW_INTS;
-
- return z;
+ scm_misc_error (subr, "dynamic linking failed", SCM_EOL);
+ return shl;
}
-SCM_PROC (s_dynamic_call, "dynamic-call", 2, 0, 0, scm_dynamic_call);
-
-SCM
-scm_dynamic_call (symb, shl)
- SCM symb, shl;
+static void
+sysdep_dynl_unlink (handle, subr)
+ void *handle;
+ char *subr;
{
- void (*func)() = 0;
- int i;
-
- symb = scm_coerce_rostring (symb, s_dynamic_call, SCM_ARG1);
- SCM_ASSERT (SCM_NIMP (shl) && SCM_CAR (shl) == scm_tc16_shl, shl, SCM_ARG2,
- s_dynamic_call);
-
- SCM_DEFER_INTS;
- if (shl_findsym (&SHL(shl), SCM_CHARS(symb), TYPE_PROCEDURE, &func))
- scm_misc_error (s_dynamic_call, "undefined function",
- scm_cons (symb, SCM_EOL));
- SCM_ALLOW_INTS;
-
- (*func) ();
- return SCM_BOOL_T;
-}
-
-SCM_PROC (s_dynamic_args_call, "dynamic-args-call", 3, 0, 0, scm_dynamic_args_call);
-
-SCM
-scm_dynamic_args_call (symb, shl, args)
- SCM symb, shl, args;
-{
- int i, argc;
- char **argv;
- int (*func) SCM_P ((int argc, char **argv)) = 0;
-
- symb = scm_coerce_rostring (symb, s_dynamic_args_call, SCM_ARG1);
- SCM_ASSERT (SCM_NIMP (shl) && SCM_CAR(shl) == scm_tc16_shl, shl, SCM_ARG2,
- s_dynamic_args_call);
-
- SCM_DEFER_INTS;
- if (shl_findsym(&SHL(shl), SCM_CHARS(symb), TYPE_PROCEDURE, &func))
- scm_misc_error (s_dynamic_call, "undefined function: %s",
- scm_cons (symb, SCM_EOL));
- argv = scm_make_argv_from_stringlist (args, &argc, s_dynamic_args_call,
- SCM_ARG3);
- SCM_ALLOW_INTS;
-
- i = (*func) (argc, argv);
+ int status;
SCM_DEFER_INTS;
- scm_must_free_argv (argv);
+ status = shl_unload ((shl_t) handle);
SCM_ALLOW_INTS;
- return SCM_MAKINUM (0L+i);
+ if (status)
+ scm_misc_error (subr, "dynamic unlinking failed", SCM_EOL);
}
-SCM_PROC (s_dynamic_unlink, "dynamic-unlink", 1, 0, 0, scm_dynamic_unlink);
-
-SCM
-scm_dynamic_unlink (shl)
- SCM shl;
+static void *
+sysdep_dynl_func (symb, handle, subr)
+ char *symb;
+ void *handle;
+ char *subr;
{
+ void (*func)() = NULL;
int status;
- SCM_ASSERT (SCM_NIMP (shl) && SCM_CAR (shl) == scm_tc16_shl, shl,
- SCM_ARG1, s_dynamic_unlink);
SCM_DEFER_INTS;
- status = shl_unload (SHL (shl));
+ status = shl_findsym ((shl_t) handle, symb, TYPE_PROCEDURE, &func);
SCM_ALLOW_INTS;
- if (!status)
- return SCM_BOOL_T;
- return SCM_BOOL_F;
+ if (status)
+ scm_misc_error (s_dynamic_call, "undefined function",
+ scm_cons (scm_makfrom0str (symb), SCM_EOL));
+ return func;
}
-void
-scm_init_dynamic_linking ()
+static void
+sysdep_dynl_init ()
{
- scm_tc16_shl = scm_newsmob (&shlsmob);
-#include "dynl.x"
}
diff --git a/libguile/dynl.c b/libguile/dynl.c
index 800de3d7b..4dfe8eac9 100644
--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@@ -45,7 +45,25 @@
Author: Aubrey Jaffer
Modified for libguile by Marius Vollmer */
+/* XXX - This is only here to drag in a definition of __eprintf. This
+ is needed for proper operation of dynamic linking. The real
+ solution would probably be a shared libgcc. */
+
+#undef NDEBUG
+#include <assert.h>
+
+static void
+maybe_drag_in_eprintf ()
+{
+ assert (!maybe_drag_in_eprintf);
+}
+
#include "_scm.h"
+#include "dynl.h"
+#include "genio.h"
+#include "smob.h"
+
+#ifdef DYNAMIC_LINKING
/* Converting a list of SCM strings into a argv-style array. You must
have ints disabled for the whole lifetime of the created argv (from
@@ -119,10 +137,92 @@ scm_coerce_rostring (rostr, subr, argn)
return rostr;
}
+/* Module registry
+ */
+
+/* We can't use SCM objects here. One should be able to call
+ SCM_REGISTER_MODULE from a C++ constructor for a static
+ object. This happens before main and thus before libguile is
+ initialized. */
+
+struct moddata {
+ struct moddata *link;
+ char *module_name;
+ void *init_func;
+};
+
+static struct moddata *registered_mods = NULL;
+
+void
+scm_register_module_xxx (module_name, init_func)
+ char *module_name;
+ void *init_func;
+{
+ struct moddata *md;
+
+ /* XXX - should we (and can we) DEFER_INTS here? */
+
+ for (md = registered_mods; md; md = md->link)
+ if (!strcmp (md->module_name, module_name)) {
+ md->init_func = init_func;
+ return;
+ }
+
+ md = (struct moddata *)malloc (sizeof (struct moddata));
+ if (md == NULL)
+ return;
+
+ md->module_name = module_name;
+ md->init_func = init_func;
+ md->link = registered_mods;
+ registered_mods = md;
+}
+
+SCM_PROC (s_registered_modules, "c-registered-modules", 0, 0, 0, scm_registered_modules);
+
+SCM
+scm_registered_modules ()
+{
+ SCM res;
+ struct moddata *md;
+
+ res = SCM_EOL;
+ for (md = registered_mods; md; md = md->link)
+ res = scm_cons (scm_cons (scm_makfrom0str (md->module_name),
+ scm_ulong2num ((unsigned long) md->init_func)),
+ res);
+ return res;
+}
+
+SCM_PROC (s_clear_registered_modules, "c-clear-registered-modules", 0, 0, 0, scm_clear_registered_modules);
+
+SCM
+scm_clear_registered_modules ()
+{
+ struct moddata *md1, *md2;
+
+ SCM_DEFER_INTS;
+
+ for (md1 = registered_mods; md1; md1 = md2) {
+ md2 = md1->link;
+ free (md1);
+ }
+ registered_mods = NULL;
+
+ SCM_ALLOW_INTS;
+ return SCM_UNSPECIFIED;
+}
+
/* Dispatch to the system dependent files
+ *
+ * They define these static functions:
*/
-#ifdef DYNAMIC_LINKING
+static void sysdep_dynl_init SCM_P ((void));
+static void *sysdep_dynl_link SCM_P ((char *filename, char *subr));
+static void sysdep_dynl_unlink SCM_P ((void *handle, char *subr));
+static void *sysdep_dynl_func SCM_P ((char *symbol, void *handle, char *subr));
+
#ifdef HAVE_LIBDL
#include "dynl-dl.c"
#else
@@ -132,16 +232,176 @@ scm_coerce_rostring (rostr, subr, argn)
#ifdef HAVE_DLD
#include "dynl-dld.c"
#else /* no dynamic linking available */
+/* configure should not have defined DYNAMIC_LINKING in this case */
+#error Dynamic linking not implemented for your system.
+#endif
+#endif
+#endif
+
+int scm_tc16_dynamic_obj;
+
+struct dynl_obj {
+ SCM filename;
+ void *handle;
+};
+
+static SCM mark_dynl_obj SCM_P ((SCM ptr));
+static SCM
+mark_dynl_obj (ptr)
+ SCM ptr;
+{
+ struct dynl_obj *d = (struct dynl_obj *)SCM_CDR (ptr);
+ SCM_SETGC8MARK (ptr);
+ return d->filename;
+}
+
+static int print_dynl_obj SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
+static int
+print_dynl_obj (exp, port, pstate)
+ SCM exp;
+ SCM port;
+ scm_print_state *pstate;
+{
+ struct dynl_obj *d = (struct dynl_obj *)SCM_CDR (exp);
+ scm_gen_puts (scm_regular_string, "#<dynamic-object ", port);
+ scm_iprin1 (d->filename, port, pstate);
+ scm_gen_putc ('>', port);
+ return 1;
+}
+
+static scm_smobfuns dynl_obj_smob = {
+ mark_dynl_obj,
+ scm_free0,
+ print_dynl_obj
+};
+
+SCM_PROC (s_dynamic_link, "dynamic-link", 1, 0, 0, scm_dynamic_link);
+
+SCM
+scm_dynamic_link (fname)
+ SCM fname;
+{
+ SCM z;
+ struct dynl_obj *d;
+
+ fname = scm_coerce_rostring (fname, s_dynamic_link, SCM_ARG1);
+ d = (struct dynl_obj *)scm_must_malloc (sizeof (struct dynl_obj),
+ s_dynamic_link);
+ d->filename = fname;
+
+ SCM_DEFER_INTS;
+ d->handle = sysdep_dynl_link (SCM_CHARS (fname), s_dynamic_link);
+ SCM_NEWCELL (z);
+ SCM_SETCHARS (z, d);
+ SCM_SETCAR (z, scm_tc16_dynamic_obj);
+ SCM_ALLOW_INTS;
+
+ return z;
+}
+
+static struct dynl_obj *get_dynl_obj SCM_P ((SCM obj, char *subr, int argn));
+static struct dynl_obj *
+get_dynl_obj (dobj, subr, argn)
+ SCM dobj;
+ char *subr;
+ int argn;
+{
+ struct dynl_obj *d;
+ SCM_ASSERT (SCM_NIMP (dobj) && SCM_CAR (dobj) == scm_tc16_dynamic_obj,
+ dobj, argn, subr);
+ d = (struct dynl_obj *)SCM_CDR (dobj);
+ SCM_ASSERT (d->handle != NULL, dobj, argn, subr);
+ return d;
+}
+
+SCM_PROC (s_dynamic_object_p, "dynamic-object?", 1, 0, 0, scm_dynamic_object_p);
+
+SCM
+scm_dynamic_object_p (SCM obj)
+{
+ return (SCM_NIMP (obj) && SCM_CAR (obj) == scm_tc16_dynamic_obj)?
+ SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC (s_dynamic_unlink, "dynamic-unlink", 1, 0, 0, scm_dynamic_unlink);
+
+SCM
+scm_dynamic_unlink (dobj)
+ SCM dobj;
+{
+ struct dynl_obj *d = get_dynl_obj (dobj, s_dynamic_unlink, SCM_ARG1);
+ sysdep_dynl_unlink (d->handle, s_dynamic_unlink);
+ d->handle = NULL;
+ return SCM_BOOL_T;
+}
+
+SCM_PROC (s_dynamic_func, "dynamic-func", 2, 0, 0, scm_dynamic_func);
+
+SCM
+scm_dynamic_func (SCM symb, SCM dobj)
+{
+ struct dynl_obj *d;
+ void (*func) ();
+
+ symb = scm_coerce_rostring (symb, s_dynamic_func, SCM_ARG1);
+ d = get_dynl_obj (dobj, s_dynamic_func, SCM_ARG2);
+
+ func = sysdep_dynl_func (d->handle, SCM_CHARS (symb), s_dynamic_func);
+ return scm_ulong2num ((unsigned long)func);
+}
+
+SCM_PROC (s_dynamic_call, "dynamic-call", 2, 0, 0, scm_dynamic_call);
+
+SCM
+scm_dynamic_call (SCM func, SCM dobj)
+{
+ void (*fptr)();
+
+ if (SCM_NIMP (func) && SCM_ROSTRINGP (func))
+ func = scm_dynamic_func (func, dobj);
+ fptr = (void (*)()) scm_num2ulong (func, (char *)SCM_ARG1, s_dynamic_call);
+ fptr ();
+ return SCM_BOOL_T;
+}
+
+SCM_PROC (s_dynamic_args_call, "dynamic-args-call", 3, 0, 0, scm_dynamic_args_call);
+
+SCM
+scm_dynamic_args_call (func, dobj, args)
+ SCM func, dobj, args;
+{
+ int (*fptr) (int argc, char **argv);
+ int result, argc;
+ char **argv;
+
+ if (SCM_NIMP (func) && SCM_ROSTRINGP (func))
+ func = scm_dynamic_func (func, dobj);
+
+ fptr = (int (*)(int, char **)) scm_num2ulong (func, (char *)SCM_ARG1,
+ s_dynamic_args_call);
+ argv = scm_make_argv_from_stringlist (args, &argc, s_dynamic_args_call,
+ SCM_ARG3);
+
+ result = (*fptr) (argc, argv);
+
+ scm_must_free_argv (argv);
+ return SCM_MAKINUM(0L+result);
+}
+
void
scm_init_dynamic_linking ()
{
+ scm_tc16_dynamic_obj = scm_newsmob (&dynl_obj_smob);
+ sysdep_dynl_init ();
+#include "dynl.x"
}
-#endif
-#endif
-#endif
-#else /* dynamic linking disabled */
+
+#else /* not DYNAMIC_LINKING */
+
void
scm_init_dynamic_linking ()
{
+#include "dynl.x"
}
-#endif
+
+#endif /* not DYNAMIC_LINKING */
diff --git a/libguile/dynl.h b/libguile/dynl.h
index 723d2e950..c61805752 100644
--- a/libguile/dynl.h
+++ b/libguile/dynl.h
@@ -47,10 +47,16 @@
+void scm_register_module_xxx SCM_P ((char *module_name, void *init_func));
+SCM scm_registered_modules SCM_P (());
+SCM scm_clear_registered_modules SCM_P (());
+
SCM scm_dynamic_link SCM_P ((SCM fname));
-SCM scm_dynamic_call SCM_P ((SCM symb, SCM shl));
-SCM scm_dynamic_args_call SCM_P ((SCM symb, SCM shl, SCM args));
-SCM scm_dynamic_unlink SCM_P ((SCM shl));
+SCM scm_dynamic_unlink SCM_P ((SCM dobj));
+SCM scm_dynamic_object_p SCM_P ((SCM obj));
+SCM scm_dynamic_func SCM_P ((SCM symb, SCM dobj));
+SCM scm_dynamic_call SCM_P ((SCM symb, SCM dobj));
+SCM scm_dynamic_args_call SCM_P ((SCM symb, SCM dobj, SCM args));
void scm_init_dynamic_linking SCM_P ((void));