* dynl.c (scm_dynamic_func): New function to get the address of a
authorMarius Vollmer <mvo@zagadka.de>
Sat, 18 Jan 1997 11:40:31 +0000 (11:40 +0000)
committerMarius Vollmer <mvo@zagadka.de>
Sat, 18 Jan 1997 11:40:31 +0000 (11:40 +0000)
function in a dynamic object.
(scm_dynamic_call, scm_dynamic_args_call): Accept the values
produced by scm_dynamic_func as the thing to call.

* dynl.c, dynl-dl.c, dynl-dld.c, dynl-shl.c: Restructured.
(scm_register_module_xxx, scm_registered_modules,
scm_clear_registered_modules): New functions.

libguile/dynl-dl.c
libguile/dynl-dld.c
libguile/dynl-shl.c
libguile/dynl.c
libguile/dynl.h

index 7899b32..96a78e4 100644 (file)
    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"
 }
index aba8b93..96a51df 100644 (file)
    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
index b8e4744..4612fa9 100644 (file)
    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"
 }
index 800de3d..4dfe8ea 100644 (file)
    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 */
index 723d2e9..c618057 100644 (file)
 
 \f
 
+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));