/* dynl.c - dynamic linking
*
- * Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001 Free Software Foundation, Inc.
+ * Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002 Free Software Foundation, Inc.
*
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
- *
- * This program 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 General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
+ * This library 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 2.1 of the License, or (at your option) any later version.
*
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
- *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE. If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way. To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
+ * This library 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.
*
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice. */
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ */
#include "libguile/lang.h"
#include "libguile/validate.h"
-/* Create a new C argv array from a scheme list of strings. */
-/* Dirk:FIXME:: A quite similar function is implemented in posix.c */
-/* Dirk:FIXME:: In case of assertion errors, we get memory leaks */
-
-/* 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
- before MAKE_ARGV_FROM_STRINGLIST until after
- MUST_FREE_ARGV). Atleast this is was the documentation for
- MAKARGVFROMSTRS says, it isn't really used that way.
-
- This code probably belongs into strings.c
- (Dirk: IMO strings.c is not the right place.) */
-
-static char **
-scm_make_argv_from_stringlist (SCM args, int *argcp, const char *subr,
- int argn)
-{
- char **argv;
- int argc;
- int i;
-
- argc = scm_ilength (args);
- SCM_ASSERT (argc >= 0, args, argn, subr);
- argv = (char **) scm_malloc ((argc + 1) * sizeof (char *));
- for (i = 0; !SCM_NULL_OR_NIL_P (args); args = SCM_CDR (args), ++i) {
- SCM arg = SCM_CAR (args);
- size_t len;
- char *dst;
- char *src;
-
- SCM_ASSERT (SCM_STRINGP (arg), args, argn, subr);
- len = SCM_STRING_LENGTH (arg);
- src = SCM_STRING_CHARS (arg);
- dst = (char *) scm_malloc (len + 1);
- memcpy (dst, src, len);
- dst[len] = 0;
- argv[i] = dst;
- }
-
- if (argcp)
- *argcp = argc;
- argv[argc] = 0;
- return argv;
-}
-
-static void
-scm_free_argv (char **argv)
-{
- char **av = argv;
- while (*av)
- free (*(av++));
- free (argv);
-}
+#include "guile-ltdl.h"
-/* Dispatch to the system dependent files
- *
- * They define some static functions. These functions are called with
- * deferred interrupts. When they want to throw errors, they are
- * expected to insert a SCM_ALLOW_INTS before doing the throw. It
- * might work to throw an error while interrupts are deferred (because
- * they will be unconditionally allowed the next time a SCM_ALLOW_INTS
- * is executed, SCM_DEFER_INTS and SCM_ALLOW_INTS do not nest).
- */
-
-#ifdef DYNAMIC_LINKING
+/*
+ From the libtool manual: "Note that libltdl is not threadsafe,
+ i.e. a multithreaded application has to use a mutex for libltdl.".
-#include "libltdl/ltdl.h"
+ Guile does not currently support pre-emptive threads, so there is
+ no mutex. Previously SCM_DEFER_INTS and SCM_ALLOW_INTS were used:
+ they are mentioned here in case somebody is grepping for thread
+ problems ;)
+*/
static void *
sysdep_dynl_link (const char *fname, const char *subr)
{
- lt_dlhandle handle;
- handle = lt_dlopenext (fname);
+ scm_lt_dlhandle handle;
+ handle = scm_lt_dlopenext (fname);
if (NULL == handle)
{
SCM fn;
SCM msg;
- SCM_ALLOW_INTS;
fn = scm_makfrom0str (fname);
- msg = scm_makfrom0str (lt_dlerror ());
+ msg = scm_makfrom0str (scm_lt_dlerror ());
scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
}
return (void *) handle;
static void
sysdep_dynl_unlink (void *handle, const char *subr)
{
- if (lt_dlclose ((lt_dlhandle) handle))
+ if (scm_lt_dlclose ((scm_lt_dlhandle) handle))
{
- SCM_ALLOW_INTS;
- scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);
+ scm_misc_error (subr, (char *) scm_lt_dlerror (), SCM_EOL);
}
}
{
void *fptr;
- fptr = lt_dlsym ((lt_dlhandle) handle, symb);
+ fptr = scm_lt_dlsym ((scm_lt_dlhandle) handle, symb);
if (!fptr)
{
- SCM_ALLOW_INTS;
- scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);
+ scm_misc_error (subr, (char *) scm_lt_dlerror (), SCM_EOL);
}
return fptr;
}
static void
sysdep_dynl_init ()
{
- lt_dlinit ();
-}
-
-#else
-
-/* no dynamic linking available, throw errors. */
-
-static void
-sysdep_dynl_init (void)
-{
-}
-
-static void
-no_dynl_error (const char *subr)
-{
- SCM_ALLOW_INTS;
- scm_misc_error (subr, "dynamic linking not available", SCM_EOL);
-}
-
-static void *
-sysdep_dynl_link (const char *filename, const char *subr)
-{
- no_dynl_error (subr);
- return NULL;
-}
-
-static void
-sysdep_dynl_unlink (void *handle,
- const char *subr)
-{
- no_dynl_error (subr);
-}
-
-static void *
-sysdep_dynl_func (const char *symbol,
- void *handle,
- const char *subr)
-{
- no_dynl_error (subr);
- return NULL;
+ scm_lt_dlinit ();
}
-#endif
-
scm_t_bits scm_tc16_dynamic_obj;
#define DYNL_FILENAME(x) (SCM_CELL_OBJECT_1 (x))
SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 0,
(SCM filename),
- "Open the dynamic library called @var{filename}. A library\n"
- "handle representing the opened library is returned; this handle\n"
- "should be used as the @var{dobj} argument to the following\n"
- "functions.")
+ "Find the shared object (shared library) denoted by\n"
+ "@var{filename} and link it into the running Guile\n"
+ "application. The returned\n"
+ "scheme object is a ``handle'' for the library which can\n"
+ "be passed to @code{dynamic-func}, @code{dynamic-call} etc.\n\n"
+ "Searching for object files is system dependent. Normally,\n"
+ "if @var{filename} does have an explicit directory it will\n"
+ "be searched for in locations\n"
+ "such as @file{/usr/lib} and @file{/usr/local/lib}.")
#define FUNC_NAME s_scm_dynamic_link
{
void *handle;
SCM_DEFINE (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}\n"
- "otherwise.")
+ "Return @code{#t} if @var{obj} is a dynamic object handle,\n"
+ "or @code{#f} otherwise.")
#define FUNC_NAME s_scm_dynamic_object_p
{
return SCM_BOOL (SCM_TYP16_PREDICATE (scm_tc16_dynamic_obj, obj));
SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0,
(SCM dobj),
- "Unlink the indicated object file from the application. The\n"
- "argument @var{dobj} must have been obtained by a call to\n"
- "@code{dynamic-link}. After @code{dynamic-unlink} has been\n"
- "called on @var{dobj}, its content is no longer accessible.")
+ "Unlink a dynamic object from the application, if possible. The\n"
+ "object must have been linked by @code{dynamic-link}, with \n"
+ "@var{dobj} the corresponding handle. After this procedure\n"
+ "is called, the handle can no longer be used to access the\n"
+ "object.")
#define FUNC_NAME s_scm_dynamic_unlink
{
/*fixme* GC-problem */
if (DYNL_HANDLE (dobj) == NULL) {
SCM_MISC_ERROR ("Already unlinked: ~S", dobj);
} else {
- SCM_DEFER_INTS;
sysdep_dynl_unlink (DYNL_HANDLE (dobj), FUNC_NAME);
SET_DYNL_HANDLE (dobj, NULL);
- SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
}
SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
(SCM name, SCM dobj),
- "Search the dynamic object @var{dobj} for the C function\n"
- "indicated by the string @var{name} and return some Scheme\n"
- "handle that can later be used with @code{dynamic-call} to\n"
- "actually call the function.\n\n"
- "Regardless whether your C compiler prepends an underscore @samp{_} to\n"
- "the global names in a program, you should @strong{not} include this\n"
- "underscore in @var{function}. Guile knows whether the underscore is\n"
- "needed or not and will add it when necessary.")
+ "Return a ``handle'' for the function @var{name} in the\n"
+ "shared object referred to by @var{dobj}. The handle\n"
+ "can be passed to @code{dynamic-call} to actually\n"
+ "call the function.\n\n"
+ "Regardless whether your C compiler prepends an underscore\n"
+ "@samp{_} to the global names in a program, you should\n"
+ "@strong{not} include this underscore in @var{name}\n"
+ "since it will be added automatically when necessary.")
#define FUNC_NAME s_scm_dynamic_func
{
/* The returned handle is formed by casting the address of the function to a
} else {
char *chars;
- SCM_DEFER_INTS;
chars = SCM_STRING_CHARS (name);
func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj), FUNC_NAME);
- SCM_ALLOW_INTS;
return scm_ulong2num ((unsigned long) func);
}
}
SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0,
(SCM func, SCM dobj),
- "Call the C function indicated by @var{func} and @var{dobj}.\n"
- "The function is passed no arguments and its return value is\n"
- "ignored. When @var{function} is something returned by\n"
- "@code{dynamic-func}, call that function and ignore @var{dobj}.\n"
- "When @var{func} is a string , look it up in @var{dynobj}; this\n"
- "is equivalent to\n"
- "@smallexample\n"
- "(dynamic-call (dynamic-func @var{func} @var{dobj} #f))\n"
- "@end smallexample\n\n"
- "Interrupts are deferred while the C function is executing (with\n"
- "@code{SCM_DEFER_INTS}/@code{SCM_ALLOW_INTS}).")
+ "Call a C function in a dynamic object. Two styles of\n"
+ "invocation are supported:\n\n"
+ "@itemize @bullet\n"
+ "@item @var{func} can be a function handle returned by\n"
+ "@code{dynamic-func}. In this case @var{dobj} is\n"
+ "ignored\n"
+ "@item @var{func} can be a string with the name of the\n"
+ "function to call, with @var{dobj} the handle of the\n"
+ "dynamic object in which to find the function.\n"
+ "This is equivalent to\n"
+ "@smallexample\n\n"
+ "(dynamic-call (dynamic-func @var{func} @var{dobj}) #f)\n"
+ "@end smallexample\n"
+ "@end itemize\n\n"
+ "In either case, the function is passed no arguments\n"
+ "and its return value is ignored.")
#define FUNC_NAME s_scm_dynamic_call
{
void (*fptr) ();
if (SCM_STRINGP (func))
func = scm_dynamic_func (func, dobj);
fptr = (void (*) ()) SCM_NUM2ULONG (1, func);
- SCM_DEFER_INTS;
fptr ();
- SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
+/* return a newly allocated array of char pointers to each of the strings
+ in args, with a terminating NULL pointer. */
+/* Note: a similar function is defined in posix.c, but we don't necessarily
+ want to export it. */
+static char **allocate_string_pointers (SCM args, int *num_args_return)
+{
+ char **result;
+ int n_args = scm_ilength (args);
+ int i;
+
+ SCM_ASSERT (n_args >= 0, args, SCM_ARGn, "allocate_string_pointers");
+ result = (char **) scm_malloc ((n_args + 1) * sizeof (char *));
+ result[n_args] = NULL;
+ for (i = 0; i < n_args; i++)
+ {
+ SCM car = SCM_CAR (args);
+
+ if (!SCM_STRINGP (car))
+ {
+ free (result);
+ scm_wrong_type_arg ("allocate_string_pointers", SCM_ARGn, car);
+ }
+ result[i] = SCM_STRING_CHARS (SCM_CAR (args));
+ args = SCM_CDR (args);
+ }
+ *num_args_return = n_args;
+ return result;
+}
+
SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0,
(SCM func, SCM dobj, SCM args),
"Call the C function indicated by @var{func} and @var{dobj},\n"
func = scm_dynamic_func (func, dobj);
fptr = (int (*) (int, char **)) SCM_NUM2ULONG (1, func);
- SCM_DEFER_INTS;
- argv = scm_make_argv_from_stringlist (args, &argc, FUNC_NAME, SCM_ARG3);
+ argv = allocate_string_pointers (args, &argc);
+ /* if the procedure mutates its arguments, the original strings will be
+ changed -- in Guile 1.6 and earlier, this wasn't the case since a
+ new copy of each string was allocated. */
result = (*fptr) (argc, argv);
- scm_free_argv (argv);
- SCM_ALLOW_INTS;
+ free (argv);
return SCM_MAKINUM (0L + result);
}