/* dynl.c - dynamic linking
*
* Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002,
- * 2003 Free Software Foundation, Inc.
+ * 2003, 2008, 2009, 2010 Free Software Foundation, Inc.
*
* 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.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
*
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * 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.
*
* 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
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
*/
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
/* "dynl.c" dynamically link&load object files.
Author: Aubrey Jaffer
Modified for libguile by Marius Vollmer */
#include <string.h>
#include "libguile/_scm.h"
+#include "libguile/libpath.h"
#include "libguile/dynl.h"
#include "libguile/smob.h"
#include "libguile/keywords.h"
#include "libguile/lang.h"
#include "libguile/validate.h"
#include "libguile/dynwind.h"
+#include "libguile/foreign.h"
#include <ltdl.h>
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)
}
static void *
-sysdep_dynl_func (const char *symb, void *handle, const char *subr)
+sysdep_dynl_value (const char *symb, void *handle, const char *subr)
{
void *fptr;
static void
sysdep_dynl_init ()
{
+ char *env;
+
lt_dlinit ();
+
+ env = getenv ("GUILE_SYSTEM_EXTENSIONS_PATH");
+ if (env && strcmp (env, "") == 0)
+ /* special-case interpret system-ltdl-path=="" as meaning no system path,
+ which is the case during the build */
+ ;
+ else if (env)
+ /* FIXME: should this be a colon-separated path? Or is the only point to
+ allow the build system to turn off the installed extensions path? */
+ lt_dladdsearchdir (env);
+ else
+ {
+ lt_dladdsearchdir (SCM_LIB_DIR);
+ lt_dladdsearchdir (SCM_EXTENSIONS_DIR);
+ }
}
scm_t_bits scm_tc16_dynamic_obj;
#define SET_DYNL_HANDLE(x, v) (SCM_SET_SMOB_DATA_2 ((x), (scm_t_bits) (v)))
-static SCM
-dynl_obj_mark (SCM ptr)
-{
- return DYNL_FILENAME (ptr);
-}
-
static int
dynl_obj_print (SCM exp, SCM port, scm_print_state *pstate)
void *handle;
char *file;
- scm_frame_begin (0);
+ scm_dynwind_begin (0);
file = scm_to_locale_string (filename);
- scm_frame_free (file);
+ scm_dynwind_free (file);
handle = sysdep_dynl_link (file, FUNC_NAME);
- scm_frame_end ();
+ scm_dynwind_end ();
SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj, SCM_UNPACK (filename), handle);
}
#undef FUNC_NAME
#undef FUNC_NAME
-SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
- (SCM name, SCM dobj),
- "Return a ``handle'' for the function @var{name} in the\n"
+SCM_DEFINE (scm_dynamic_pointer, "dynamic-pointer", 3, 1, 0,
+ (SCM name, SCM type, SCM dobj, SCM len),
+ "Return a ``handle'' for the pointer @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"
+ "aliases a C value, and is declared to be of type\n"
+ "@var{type}. Valid types are defined in the\n"
+ "@code{(system vm ffi)} module.\n\n"
+ "This facility works by asking the operating system for\n"
+ "the address of a symbol, then assuming that it aliases a\n"
+ "value of a given type. Obviously, the user must be very\n"
+ "careful to ensure that the value actually is of the\n"
+ "declared type, or bad things will happen.\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
+#define FUNC_NAME s_scm_dynamic_pointer
{
- /* The returned handle is formed by casting the address of the function to a
- * long value and converting this to a scheme number
- */
-
- void (*func) ();
+ void *val;
+ scm_t_foreign_type t;
SCM_VALIDATE_STRING (1, name);
+ t = scm_to_unsigned_integer (type, 0, SCM_FOREIGN_TYPE_LAST);
/*fixme* GC-problem */
- SCM_VALIDATE_SMOB (SCM_ARG2, dobj, dynamic_obj);
+ SCM_VALIDATE_SMOB (SCM_ARG3, dobj, dynamic_obj);
if (DYNL_HANDLE (dobj) == NULL) {
SCM_MISC_ERROR ("Already unlinked: ~S", dobj);
} else {
char *chars;
- scm_frame_begin (0);
+ scm_dynwind_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);
+ scm_dynwind_free (chars);
+ val = sysdep_dynl_value (chars, DYNL_HANDLE (dobj), FUNC_NAME);
+ scm_dynwind_end ();
+ return scm_take_foreign_pointer (t, val,
+ SCM_UNBNDP (len) ? 0 : scm_to_size_t (len),
+ NULL);
}
}
#undef FUNC_NAME
+SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
+ (SCM name, SCM dobj),
+ "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
+{
+ return scm_dynamic_pointer (name,
+ scm_from_uint (SCM_FOREIGN_TYPE_VOID),
+ dobj,
+ SCM_UNDEFINED);
+}
+#undef FUNC_NAME
+
+
SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0,
(SCM func, SCM dobj),
"Call a C function in a dynamic object. Two styles of\n"
if (scm_is_string (func))
func = scm_dynamic_func (func, dobj);
- fptr = (void (*) ()) scm_to_ulong (func);
+ SCM_VALIDATE_FOREIGN_TYPED (SCM_ARG1, func, VOID);
+
+ fptr = SCM_FOREIGN_POINTER (func, void);
fptr ();
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
-static void
-free_string_pointers (void *data)
-{
- scm_i_free_string_pointers ((char **)data);
-}
-
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"
int result, argc;
char **argv;
- scm_frame_begin (0);
-
if (scm_is_string (func))
func = scm_dynamic_func (func, dobj);
+ SCM_VALIDATE_FOREIGN_TYPED (SCM_ARG1, func, VOID);
- fptr = (int (*) (int, char **)) scm_to_ulong (func);
+ fptr = SCM_FOREIGN_POINTER (func, void);
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);
- scm_frame_end ();
return scm_from_int (result);
}
#undef FUNC_NAME
scm_init_dynamic_linking ()
{
scm_tc16_dynamic_obj = scm_make_smob_type ("dynamic-object", 0);
- scm_set_smob_mark (scm_tc16_dynamic_obj, dynl_obj_mark);
scm_set_smob_print (scm_tc16_dynamic_obj, dynl_obj_print);
sysdep_dynl_init ();
#include "libguile/dynl.x"
HCoop / bpt / guile.git / blobdiff