* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
+/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
+ gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
+
+
/* "dynl.c" dynamically link&load object files.
Author: Aubrey Jaffer
Modified for libguile by Marius Vollmer */
#include "dynl.h"
#include "genio.h"
#include "smob.h"
+#include "keywords.h"
/* 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
This code probably belongs into strings.c */
-static char **scm_make_argv_from_stringlist SCM_P ((SCM args, int *argcp,
- const char *subr, int argn));
-
static char **
-scm_make_argv_from_stringlist (args, argcp, subr, argn)
- SCM args;
- int *argcp;
- const char *subr;
- int argn;
+scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn)
{
char **argv;
int argc, i;
return argv;
}
-static void scm_must_free_argv SCM_P ((char **argv));
-
static void
-scm_must_free_argv(argv)
- char **argv;
+scm_must_free_argv(char **argv)
{
char **av = argv;
while (*av)
/* Coerce an arbitrary readonly-string into a zero-terminated string.
*/
-static SCM scm_coerce_rostring SCM_P ((SCM rostr, const char *subr, int argn));
-
static SCM
-scm_coerce_rostring (rostr, subr, argn)
- SCM rostr;
- const char *subr;
- int argn;
+scm_coerce_rostring (SCM rostr,const char *subr,int argn)
{
SCM_ASSERT (SCM_NIMP (rostr) && SCM_ROSTRINGP (rostr), rostr, argn, subr);
if (SCM_SUBSTRP (rostr))
static struct moddata *registered_mods = NULL;
void
-scm_register_module_xxx (module_name, init_func)
- char *module_name;
- void *init_func;
+scm_register_module_xxx (char *module_name, void *init_func)
{
struct moddata *md;
registered_mods = md;
}
-SCM_PROC (s_registered_modules, "c-registered-modules", 0, 0, 0, scm_registered_modules);
-
-SCM
-scm_registered_modules ()
+GUILE_PROC (scm_registered_modules, "c-registered-modules", 0, 0, 0,
+ (),
+"Return a list of the object code modules that have been imported into
+the current Guile process. Each element of the list is a pair whose
+car is the name of the module (as it might be used by
+@code{use-modules}, for instance), and whose cdr is the function handle
+for that module's initializer function.")
+#define FUNC_NAME s_scm_registered_modules
{
SCM res;
struct moddata *md;
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 ()
+#undef FUNC_NAME
+
+GUILE_PROC (scm_clear_registered_modules, "c-clear-registered-modules", 0, 0, 0,
+ (),
+"Destroy the list of modules registered with the current Guile process.
+The return value is unspecified. @strong{Warning:} this function does
+not actually unlink or deallocate these modules, but only destroys the
+records of which modules have been loaded. It should therefore be used
+only by module bookkeeping operations.")
+#define FUNC_NAME s_scm_clear_registered_modules
{
struct moddata *md1, *md2;
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
/* Dispatch to the system dependent files
*
* is executed, SCM_DEFER_INTS and SCM_ALLOW_INTS do not nest).
*/
-static void sysdep_dynl_init SCM_P ((void));
-static void *sysdep_dynl_link SCM_P ((const char *filename, const char *subr));
-static void sysdep_dynl_unlink SCM_P ((void *handle, const char *subr));
-static void *sysdep_dynl_func SCM_P ((const char *symbol, void *handle,
- const char *subr));
+#define DYNL_GLOBAL 0x0001
#ifdef HAVE_DLOPEN
#include "dynl-dl.c"
/* no dynamic linking available, throw errors. */
static void
-sysdep_dynl_init ()
+sysdep_dynl_init (void)
{
}
}
static void *
-sysdep_dynl_link (const char *filename,
+sysdep_dynl_link (const char *filename,
+ int flags,
const char *subr)
{
no_dynl_error (subr);
void *handle;
};
-static SCM mark_dynl_obj SCM_P ((SCM ptr));
static SCM
-mark_dynl_obj (ptr)
- SCM ptr;
+mark_dynl_obj (SCM ptr)
{
struct dynl_obj *d = (struct dynl_obj *)SCM_CDR (ptr);
return d->filename;
}
-static scm_sizet free_dynl_obj SCM_P ((SCM ptr));
static scm_sizet
-free_dynl_obj (ptr)
- SCM ptr;
+free_dynl_obj (SCM ptr)
{
scm_must_free ((char *)SCM_CDR (ptr));
return sizeof (struct dynl_obj);
}
-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;
+print_dynl_obj (SCM exp,SCM port,scm_print_state *pstate)
{
struct dynl_obj *d = (struct dynl_obj *)SCM_CDR (exp);
scm_puts ("#<dynamic-object ", port);
return 1;
}
-static scm_smobfuns dynl_obj_smob = {
- mark_dynl_obj,
- free_dynl_obj,
- print_dynl_obj
-};
-
-SCM_PROC (s_dynamic_link, "dynamic-link", 1, 0, 0, scm_dynamic_link);
+static SCM kw_global;
+SCM_SYMBOL (sym_global, "-global");
-SCM
-scm_dynamic_link (fname)
- SCM fname;
+GUILE_PROC (scm_dynamic_link, "dynamic-link", 1, 0, 1,
+ (SCM fname, SCM rest),
+"Open the dynamic library @var{library-file}. A library handle
+representing the opened library is returned; this handle should be used
+as the @var{lib} argument to the following functions.")
+#define FUNC_NAME s_scm_dynamic_link
{
SCM z;
void *handle;
struct dynl_obj *d;
-
- fname = scm_coerce_rostring (fname, s_dynamic_link, SCM_ARG1);
+ int flags = DYNL_GLOBAL;
+
+ fname = scm_coerce_rostring (fname, FUNC_NAME, SCM_ARG1);
+
+ /* collect flags */
+ while (SCM_NIMP (rest) && SCM_CONSP (rest))
+ {
+ SCM kw, val;
+
+ kw = SCM_CAR (rest);
+ rest = SCM_CDR (rest);
+
+ if (!(SCM_NIMP (rest) && SCM_CONSP (rest)))
+ scm_misc_error (FUNC_NAME, "keyword without value", SCM_EOL);
+
+ val = SCM_CAR (rest);
+ rest = SCM_CDR (rest);
+
+ if (kw == kw_global)
+ {
+ if (SCM_FALSEP (val))
+ flags &= ~DYNL_GLOBAL;
+ }
+ else
+ scm_misc_error (FUNC_NAME, "unknown keyword argument: %s",
+ scm_cons (kw, SCM_EOL));
+ }
SCM_DEFER_INTS;
- handle = sysdep_dynl_link (SCM_CHARS (fname), s_dynamic_link);
+ handle = sysdep_dynl_link (SCM_CHARS (fname), flags, FUNC_NAME);
d = (struct dynl_obj *)scm_must_malloc (sizeof (struct dynl_obj),
- s_dynamic_link);
+ FUNC_NAME);
d->filename = fname;
d->handle = handle;
return z;
}
+#undef FUNC_NAME
-static struct dynl_obj *get_dynl_obj SCM_P ((SCM obj, const char *subr, int argn));
static struct dynl_obj *
-get_dynl_obj (dobj, subr, argn)
- SCM dobj;
- const char *subr;
- int argn;
+get_dynl_obj (SCM dobj,const char *subr,int argn)
{
struct dynl_obj *d;
SCM_ASSERT (SCM_NIMP (dobj) && SCM_CAR (dobj) == scm_tc16_dynamic_obj,
return d;
}
-SCM_PROC (s_dynamic_object_p, "dynamic-object?", 1, 0, 0, scm_dynamic_object_p);
-
-SCM
-scm_dynamic_object_p (SCM obj)
+GUILE_PROC (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0,
+ (SCM obj),
+"Return @code{#t} if @var{obj} is a dynamic library handle, or @code{#f}
+otherwise.")
+#define FUNC_NAME s_scm_dynamic_object_p
{
- return (SCM_NIMP (obj) && SCM_CAR (obj) == scm_tc16_dynamic_obj)?
- SCM_BOOL_T : SCM_BOOL_F;
+ return SCM_BOOL(SCM_NIMP (obj) && SCM_CAR (obj) == scm_tc16_dynamic_obj);
}
-
-SCM_PROC (s_dynamic_unlink, "dynamic-unlink", 1, 0, 0, scm_dynamic_unlink);
-
-SCM
-scm_dynamic_unlink (dobj)
- SCM dobj;
+#undef FUNC_NAME
+
+GUILE_PROC (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0,
+ (SCM dobj),
+"Unlink the library represented by @var{library-handle}, and remove any
+imported symbols from the address space.
+GJB:FIXME:DOC: 2nd version below:
+Unlink the indicated object file from the application. The argument
+@var{dynobj} should be one of the values returned by
+@code{dynamic-link}. When @code{dynamic-unlink} has been called on
+@var{dynobj}, it is no longer usable as an argument to the functions
+below and you will get type mismatch errors when you try to.
+")
+#define FUNC_NAME s_scm_dynamic_unlink
{
- struct dynl_obj *d = get_dynl_obj (dobj, s_dynamic_unlink, SCM_ARG1);
+ struct dynl_obj *d = get_dynl_obj (dobj, FUNC_NAME, SCM_ARG1);
SCM_DEFER_INTS;
- sysdep_dynl_unlink (d->handle, s_dynamic_unlink);
+ sysdep_dynl_unlink (d->handle, FUNC_NAME);
d->handle = NULL;
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
-
-SCM_PROC (s_dynamic_func, "dynamic-func", 2, 0, 0, scm_dynamic_func);
-
-SCM
-scm_dynamic_func (SCM symb, SCM dobj)
+#undef FUNC_NAME
+
+GUILE_PROC (scm_dynamic_func, "dynamic-func", 2, 0, 0,
+ (SCM symb, SCM dobj),
+"Import the symbol @var{func} from @var{lib} (a dynamic library handle).
+A @dfn{function handle} representing the imported function is returned.
+GJB:FIXME:DOC: 2nd version below
+Search the C function indicated by @var{function} (a string or symbol)
+in @var{dynobj} and return some Scheme object that can later be used
+with @code{dynamic-call} to actually call this function. Right now,
+these Scheme objects are formed by casting the address of the function
+to @code{long} and converting this number to its Scheme representation.
+
+Regardless whether your C compiler prepends an underscore @samp{_} to
+the global names in a program, you should @strong{not} include this
+underscore in @var{function}. Guile knows whether the underscore is
+needed or not and will add it when necessary.
+
+")
+#define FUNC_NAME s_scm_dynamic_func
{
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);
+ symb = scm_coerce_rostring (symb, FUNC_NAME, SCM_ARG1);
+ d = get_dynl_obj (dobj, FUNC_NAME, SCM_ARG2);
SCM_DEFER_INTS;
func = (void (*) ()) sysdep_dynl_func (SCM_CHARS (symb), d->handle,
- s_dynamic_func);
+ FUNC_NAME);
SCM_ALLOW_INTS;
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)
+#undef FUNC_NAME
+
+GUILE_PROC (scm_dynamic_call, "dynamic-call", 2, 0, 0,
+ (SCM func, SCM dobj),
+"Call @var{lib-thunk}, a procedure of no arguments. If @var{lib-thunk}
+is a string, it is assumed to be a symbol found in the dynamic library
+@var{lib} and is fetched with @code{dynamic-func}. Otherwise, it should
+be a function handle returned by a previous call to @code{dynamic-func}.
+The return value is unspecified.
+GJB:FIXME:DOC 2nd version below
+Call the C function indicated by @var{function} and @var{dynobj}. The
+function is passed no arguments and its return value is ignored. When
+@var{function} is something returned by @code{dynamic-func}, call that
+function and ignore @var{dynobj}. When @var{function} is a string (or
+symbol, etc.), look it up in @var{dynobj}; this is equivalent to
+
+@smallexample
+(dynamic-call (dynamic-func @var{function} @var{dynobj} #f))
+@end smallexample
+
+Interrupts are deferred while the C function is executing (with
+@code{SCM_DEFER_INTS}/@code{SCM_ALLOW_INTS}).
+")
+#define FUNC_NAME s_scm_dynamic_call
{
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 = (void (*)()) scm_num2ulong (func, (char *)SCM_ARG1, FUNC_NAME);
SCM_DEFER_INTS;
fptr ();
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
+
+GUILE_PROC (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0,
+ (SCM func, SCM dobj, SCM args),
+"Call @var{proc}, a dynamically loaded function, passing it the argument
+list @var{args} (a list of strings). As with @code{dynamic-call},
+@var{proc} should be either a function handle or a string, in which case
+it is first fetched from @var{lib} with @code{dynamic-func}.
+
+@var{proc} is assumed to return an integer, which is used as the return
+value from @code{dynamic-args-call}.
+
+GJB:FIXME:DOC 2nd version below
+Call the C function indicated by @var{function} and @var{dynobj}, just
+like @code{dynamic-call}, but pass it some arguments and return its
+return value. The C function is expected to take two arguments and
+return an @code{int}, just like @code{main}:
+
+@smallexample
+int c_func (int argc, char **argv);
+@end smallexample
+
+The parameter @var{args} must be a list of strings and is converted into
+an array of @code{char *}. The array is passed in @var{argv} and its
+size in @var{argc}. The return value is converted to a Scheme number
+and returned from the call to @code{dynamic-args-call}.
-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;
+")
+#define FUNC_NAME s_scm_dynamic_args_call
{
int (*fptr) (int argc, char **argv);
int result, argc;
func = scm_dynamic_func (func, dobj);
fptr = (int (*)(int, char **)) scm_num2ulong (func, (char *)SCM_ARG1,
- s_dynamic_args_call);
+ FUNC_NAME);
SCM_DEFER_INTS;
- argv = scm_make_argv_from_stringlist (args, &argc, s_dynamic_args_call,
+ argv = scm_make_argv_from_stringlist (args, &argc, FUNC_NAME,
SCM_ARG3);
result = (*fptr) (argc, argv);
scm_must_free_argv (argv);
return SCM_MAKINUM(0L+result);
}
+#undef FUNC_NAME
void
scm_init_dynamic_linking ()
{
- scm_tc16_dynamic_obj = scm_newsmob (&dynl_obj_smob);
+ scm_tc16_dynamic_obj = scm_make_smob_type_mfpe ("dynamic-object", sizeof (struct dynl_obj),
+ mark_dynl_obj, free_dynl_obj,
+ print_dynl_obj, NULL);
sysdep_dynl_init ();
#include "dynl.x"
+ kw_global = scm_make_keyword_from_dash_symbol (sym_global);
}
HCoop / bpt / guile.git / blobdiff