summaryrefslogtreecommitdiff
path: root/libguile/dynl.c
diff options
context:
space:
mode:
authorNeil Jerram <neil@ossau.uklinux.net>2010-04-10 13:32:42 +0100
committerNeil Jerram <neil@ossau.uklinux.net>2010-04-10 13:32:42 +0100
commit26b9f9090073c896762af3125af54958e153f8f2 (patch)
tree11c799f1191ef122c66329c36d6b03230c6962ef /libguile/dynl.c
parent3ce5e1304bd77eb167f856a2a163038f01f452c8 (diff)
parent96ec2c9c65468b1404865371d19342d6badb0be9 (diff)
downloadguile-26b9f9090073c896762af3125af54958e153f8f2.tar.gz
Merge branch 'master' into wip-manual-2
Conflicts: doc/ref/api-procedures.texi doc/ref/misc-modules.texi (Caused by me removing `@page' from a couple of sections that have been modified by others.)
Diffstat (limited to 'libguile/dynl.c')
-rw-r--r--libguile/dynl.c151
1 files changed, 84 insertions, 67 deletions
diff --git a/libguile/dynl.c b/libguile/dynl.c
index 52c43e542..b76e85c79 100644
--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@@ -1,7 +1,7 @@
/* dynl.c - dynamic linking
*
* Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002,
- * 2003, 2008, 2009 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
@@ -55,9 +55,9 @@ maybe_drag_in_eprintf ()
#include "libguile/ports.h"
#include "libguile/strings.h"
#include "libguile/deprecation.h"
-#include "libguile/lang.h"
#include "libguile/validate.h"
#include "libguile/dynwind.h"
+#include "libguile/foreign.h"
#include <ltdl.h>
@@ -76,16 +76,23 @@ static void *
sysdep_dynl_link (const char *fname, const char *subr)
{
lt_dlhandle handle;
- handle = lt_dlopenext (fname);
+
+ if (fname != NULL)
+ handle = lt_dlopenext (fname);
+ else
+ /* Return a handle for the program as a whole. */
+ handle = lt_dlopen (NULL);
+
if (NULL == handle)
{
SCM fn;
SCM msg;
- fn = scm_from_locale_string (fname);
+ fn = fname != NULL ? scm_from_locale_string (fname) : SCM_BOOL_F;
msg = scm_from_locale_string (lt_dlerror ());
scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
}
+
return (void *) handle;
}
@@ -99,7 +106,7 @@ sysdep_dynl_unlink (void *handle, 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;
@@ -154,7 +161,7 @@ dynl_obj_print (SCM exp, SCM port, scm_print_state *pstate)
}
-SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 0,
+SCM_DEFINE (scm_dynamic_link, "dynamic-link", 0, 1, 0,
(SCM filename),
"Find the shared object (shared library) denoted by\n"
"@var{filename} and link it into the running Guile\n"
@@ -164,18 +171,33 @@ SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 0,
"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}.")
+ "such as @file{/usr/lib} and @file{/usr/local/lib}.\n\n"
+ "When @var{filename} is omitted, a @dfn{global symbol handle} is\n"
+ "returned. This handle provides access to the symbols\n"
+ "available to the program at run-time, including those exported\n"
+ "by the program itself and the shared libraries already loaded.\n")
#define FUNC_NAME s_scm_dynamic_link
{
void *handle;
char *file;
scm_dynwind_begin (0);
- file = scm_to_locale_string (filename);
- scm_dynwind_free (file);
+
+ if (SCM_UNBNDP (filename))
+ file = NULL;
+ else
+ {
+ file = scm_to_locale_string (filename);
+ scm_dynwind_free (file);
+ }
+
handle = sysdep_dynl_link (file, FUNC_NAME);
scm_dynwind_end ();
- SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj, SCM_UNPACK (filename), handle);
+
+ SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj,
+ SCM_UNBNDP (filename)
+ ? SCM_UNPACK (SCM_BOOL_F) : SCM_UNPACK (filename),
+ handle);
}
#undef FUNC_NAME
@@ -213,6 +235,51 @@ SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0,
#undef FUNC_NAME
+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"
+ "aliases a C value, and is declared to be of type\n"
+ "@var{type}. Valid types are defined in the\n"
+ "@code{(system foreign)} module.\n\n"
+ "This facility works by asking the dynamic linker 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_pointer
+{
+ void *val;
+ scm_t_foreign_type t;
+
+ SCM_VALIDATE_STRING (1, name);
+ t = scm_to_unsigned_integer (type, 0, SCM_FOREIGN_TYPE_LAST);
+ SCM_VALIDATE_SMOB (SCM_ARG3, dobj, dynamic_obj);
+
+ if (DYNL_HANDLE (dobj) == NULL)
+ SCM_MISC_ERROR ("Already unlinked: ~S", dobj);
+ else
+ {
+ char *chars;
+
+ scm_dynwind_begin (0);
+ chars = scm_to_locale_string (name);
+ 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"
@@ -225,28 +292,10 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
"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
- * long value and converting this to a scheme number
- */
-
- void (*func) ();
-
- SCM_VALIDATE_STRING (1, name);
- /*fixme* GC-problem */
- SCM_VALIDATE_SMOB (SCM_ARG2, dobj, dynamic_obj);
- if (DYNL_HANDLE (dobj) == NULL) {
- SCM_MISC_ERROR ("Already unlinked: ~S", dobj);
- } else {
- char *chars;
-
- scm_dynwind_begin (0);
- chars = scm_to_locale_string (name);
- scm_dynwind_free (chars);
- func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj),
- FUNC_NAME);
- scm_dynwind_end ();
- return scm_from_ulong ((unsigned long) func);
- }
+ return scm_dynamic_pointer (name,
+ scm_from_uint (SCM_FOREIGN_TYPE_VOID),
+ dobj,
+ SCM_UNDEFINED);
}
#undef FUNC_NAME
@@ -275,46 +324,14 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0,
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
-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"
- "just like @code{dynamic-call}, but pass it some arguments and\n"
- "return its return value. The C function is expected to take\n"
- "two arguments and return an @code{int}, just like @code{main}:\n"
- "@smallexample\n"
- "int c_func (int argc, char **argv);\n"
- "@end smallexample\n\n"
- "The parameter @var{args} must be a list of strings and is\n"
- "converted into an array of @code{char *}. The array is passed\n"
- "in @var{argv} and its size in @var{argc}. The return value is\n"
- "converted to a Scheme number and returned from the call to\n"
- "@code{dynamic-args-call}.")
-#define FUNC_NAME s_scm_dynamic_args_call
-{
- int (*fptr) (int argc, char **argv);
- int result, argc;
- char **argv;
-
- if (scm_is_string (func))
- func = scm_dynamic_func (func, dobj);
-
- fptr = (int (*) (int, char **)) scm_to_ulong (func);
-
- argv = scm_i_allocate_string_pointers (args);
- for (argc = 0; argv[argc]; argc++)
- ;
- result = (*fptr) (argc, argv);
-
- return scm_from_int (result);
-}
-#undef FUNC_NAME
-
void
scm_init_dynamic_linking ()
{