diff options
author | Neil Jerram <neil@ossau.uklinux.net> | 2010-04-10 13:32:42 +0100 |
---|---|---|
committer | Neil Jerram <neil@ossau.uklinux.net> | 2010-04-10 13:32:42 +0100 |
commit | 26b9f9090073c896762af3125af54958e153f8f2 (patch) | |
tree | 11c799f1191ef122c66329c36d6b03230c6962ef /libguile/dynl.c | |
parent | 3ce5e1304bd77eb167f856a2a163038f01f452c8 (diff) | |
parent | 96ec2c9c65468b1404865371d19342d6badb0be9 (diff) | |
download | guile-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.c | 151 |
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 () { |