/* 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,
+ * 2003 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.
- *
- * 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 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.
*
- * 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
#include "libguile/deprecation.h"
#include "libguile/lang.h"
#include "libguile/validate.h"
+#include "libguile/dynwind.h"
-#ifdef DYNAMIC_LINKING
-
-#include "libltdl/ltdl.h"
+#include <ltdl.h>
-/* From the libtool manual: "Note that libltdl is not threadsafe,
- i.e. a multithreaded application has to use a mutex for libltdl.".
+/*
+ From the libtool manual: "Note that libltdl is not threadsafe,
+ i.e. a multithreaded application has to use a mutex for libltdl.".
- 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 ;)
+ Guile does not currently support pre-emptive threads, so there is no
+ mutex. Previously SCM_CRITICAL_SECTION_START and
+ SCM_CRITICAL_SECTION_END were used: they are mentioned here in case
+ somebody is grepping for thread problems ;)
*/
+/* njrev: not threadsafe, protection needed as described above */
static void *
sysdep_dynl_link (const char *fname, const char *subr)
SCM fn;
SCM msg;
- fn = scm_makfrom0str (fname);
- msg = scm_makfrom0str (lt_dlerror ());
+ fn = scm_from_locale_string (fname);
+ msg = scm_from_locale_string (lt_dlerror ());
scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
}
return (void *) handle;
lt_dlinit ();
}
-#else
-
-/* no dynamic linking available, throw errors. */
-
-static void
-sysdep_dynl_init (void)
-{
-}
-
-static void
-no_dynl_error (const char *subr)
-{
- 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;
-}
-
-#endif
-
scm_t_bits scm_tc16_dynamic_obj;
-#define DYNL_FILENAME(x) (SCM_CELL_OBJECT_1 (x))
-#define DYNL_HANDLE(x) ((void *) SCM_CELL_WORD_2 (x))
-#define SET_DYNL_HANDLE(x, v) (SCM_SET_CELL_WORD_2 ((x), (v)))
+#define DYNL_FILENAME SCM_SMOB_OBJECT
+#define DYNL_HANDLE(x) ((void *) SCM_SMOB_DATA_2 (x))
+#define SET_DYNL_HANDLE(x, v) (SCM_SET_SMOB_DATA_2 ((x), (scm_t_bits) (v)))
static SCM
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;
+ char *file;
- SCM_VALIDATE_STRING (1, filename);
- handle = sysdep_dynl_link (SCM_STRING_CHARS (filename), FUNC_NAME);
+ scm_frame_begin (0);
+ file = scm_to_locale_string (filename);
+ scm_frame_free (file);
+ handle = sysdep_dynl_link (file, FUNC_NAME);
+ scm_frame_end ();
SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj, SCM_UNPACK (filename), handle);
}
#undef FUNC_NAME
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));
+ return scm_from_bool (SCM_TYP16_PREDICATE (scm_tc16_dynamic_obj, obj));
}
#undef FUNC_NAME
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 */
SCM_VALIDATE_SMOB (SCM_ARG1, dobj, dynamic_obj);
if (DYNL_HANDLE (dobj) == NULL) {
- SCM_MISC_ERROR ("Already unlinked: ~S", dobj);
+ SCM_MISC_ERROR ("Already unlinked: ~S", scm_list_1 (dobj));
} else {
sysdep_dynl_unlink (DYNL_HANDLE (dobj), FUNC_NAME);
SET_DYNL_HANDLE (dobj, NULL);
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;
- chars = SCM_STRING_CHARS (name);
- func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj), FUNC_NAME);
- return scm_ulong2num ((unsigned long) func);
+ scm_frame_begin (0);
+ chars = scm_to_locale_string (name);
+ scm_frame_free (chars);
+ func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj),
+ FUNC_NAME);
+ scm_frame_end ();
+ return scm_from_ulong ((unsigned long) func);
}
}
#undef FUNC_NAME
{
void (*fptr) ();
- if (SCM_STRINGP (func))
+ if (scm_is_string (func))
func = scm_dynamic_func (func, dobj);
- fptr = (void (*) ()) SCM_NUM2ULONG (1, func);
+ fptr = (void (*) ()) scm_to_ulong (func);
fptr ();
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)
+static void
+free_string_pointers (void *data)
{
- 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_i_free_string_pointers ((char **)data);
}
SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0,
int result, argc;
char **argv;
- if (SCM_STRINGP (func))
+ scm_frame_begin (0);
+
+ if (scm_is_string (func))
func = scm_dynamic_func (func, dobj);
- fptr = (int (*) (int, char **)) SCM_NUM2ULONG (1, func);
- 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. */
+ fptr = (int (*) (int, char **)) scm_to_ulong (func);
+
+ argv = scm_i_allocate_string_pointers (args);
+ scm_frame_unwind_handler (free_string_pointers, argv,
+ SCM_F_WIND_EXPLICITLY);
+ for (argc = 0; argv[argc]; argc++)
+ ;
result = (*fptr) (argc, argv);
- free (argv);
- return SCM_MAKINUM (0L + result);
+ scm_frame_end ();
+ return scm_from_int (result);
}
#undef FUNC_NAME