mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 20:00:19 +02:00
Change `dynamic-link' to return a global handle when the argument is omitted.
* libguile/dynl.c (sysdep_dynl_link): Handle FNAME == NULL. (scm_dynamic_link): Make argument optional. Adjust body accordingly. * test-suite/standalone/test-ffi (global, strerror, strlen): New bindings. Add test for these bindings. * doc/ref/api-modules.texi (Low level dynamic linking): Update description of `dynamic-link'.
This commit is contained in:
parent
dd1464bf38
commit
d12f974b43
3 changed files with 61 additions and 9 deletions
|
@ -1,6 +1,6 @@
|
||||||
@c -*-texinfo-*-
|
@c -*-texinfo-*-
|
||||||
@c This is part of the GNU Guile Reference Manual.
|
@c This is part of the GNU Guile Reference Manual.
|
||||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008, 2009
|
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008, 2009, 2010
|
||||||
@c Free Software Foundation, Inc.
|
@c Free Software Foundation, Inc.
|
||||||
@c See the file guile.texi for copying conditions.
|
@c See the file guile.texi for copying conditions.
|
||||||
|
|
||||||
|
@ -1029,7 +1029,7 @@ When using the low level procedures to do your dynamic linking, you have
|
||||||
complete control over which library is loaded when and what gets done
|
complete control over which library is loaded when and what gets done
|
||||||
with it.
|
with it.
|
||||||
|
|
||||||
@deffn {Scheme Procedure} dynamic-link library
|
@deffn {Scheme Procedure} dynamic-link [library]
|
||||||
@deffnx {C Function} scm_dynamic_link (library)
|
@deffnx {C Function} scm_dynamic_link (library)
|
||||||
Find the shared library denoted by @var{library} (a string) and link it
|
Find the shared library denoted by @var{library} (a string) and link it
|
||||||
into the running Guile application. When everything works out, return a
|
into the running Guile application. When everything works out, return a
|
||||||
|
@ -1040,6 +1040,11 @@ dependent.
|
||||||
Normally, @var{library} is just the name of some shared library file
|
Normally, @var{library} is just the name of some shared library file
|
||||||
that will be searched for in the places where shared libraries usually
|
that will be searched for in the places where shared libraries usually
|
||||||
reside, such as in @file{/usr/lib} and @file{/usr/local/lib}.
|
reside, such as in @file{/usr/lib} and @file{/usr/local/lib}.
|
||||||
|
|
||||||
|
When @var{library} is omitted, a @dfn{global symbol handle} is returned. This
|
||||||
|
handle provides access to the symbols available to the program at run-time,
|
||||||
|
including those exported by the program itself and the shared libraries already
|
||||||
|
loaded.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@deffn {Scheme Procedure} dynamic-object? obj
|
@deffn {Scheme Procedure} dynamic-object? obj
|
||||||
|
|
|
@ -77,16 +77,23 @@ static void *
|
||||||
sysdep_dynl_link (const char *fname, const char *subr)
|
sysdep_dynl_link (const char *fname, const char *subr)
|
||||||
{
|
{
|
||||||
lt_dlhandle handle;
|
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)
|
if (NULL == handle)
|
||||||
{
|
{
|
||||||
SCM fn;
|
SCM fn;
|
||||||
SCM msg;
|
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 ());
|
msg = scm_from_locale_string (lt_dlerror ());
|
||||||
scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
|
scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
|
||||||
}
|
}
|
||||||
|
|
||||||
return (void *) handle;
|
return (void *) handle;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -155,7 +162,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),
|
(SCM filename),
|
||||||
"Find the shared object (shared library) denoted by\n"
|
"Find the shared object (shared library) denoted by\n"
|
||||||
"@var{filename} and link it into the running Guile\n"
|
"@var{filename} and link it into the running Guile\n"
|
||||||
|
@ -165,18 +172,33 @@ SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 0,
|
||||||
"Searching for object files is system dependent. Normally,\n"
|
"Searching for object files is system dependent. Normally,\n"
|
||||||
"if @var{filename} does have an explicit directory it will\n"
|
"if @var{filename} does have an explicit directory it will\n"
|
||||||
"be searched for in locations\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
|
#define FUNC_NAME s_scm_dynamic_link
|
||||||
{
|
{
|
||||||
void *handle;
|
void *handle;
|
||||||
char *file;
|
char *file;
|
||||||
|
|
||||||
scm_dynwind_begin (0);
|
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);
|
handle = sysdep_dynl_link (file, FUNC_NAME);
|
||||||
scm_dynwind_end ();
|
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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -168,6 +168,31 @@ exec guile -q -s "$0" "$@"
|
||||||
'(0 1 2 3 4 5 6 7 0 0 0 0 0 0 0 0))
|
'(0 1 2 3 4 5 6 7 0 0 0 0 0 0 0 0))
|
||||||
(error "unexpected dest")))
|
(error "unexpected dest")))
|
||||||
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Global symbols.
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(use-modules ((rnrs bytevector) #:select (utf8->string)))
|
||||||
|
|
||||||
|
(if (defined? 'setlocale)
|
||||||
|
(setlocale LC_ALL "C"))
|
||||||
|
|
||||||
|
(define global (dynamic-link))
|
||||||
|
|
||||||
|
(define strerror
|
||||||
|
(make-foreign-function '* (dynamic-func "strerror" global)
|
||||||
|
(list int)))
|
||||||
|
|
||||||
|
(define strlen
|
||||||
|
(make-foreign-function size_t (dynamic-func "strlen" global)
|
||||||
|
(list '*)))
|
||||||
|
|
||||||
|
(let* ((ptr (strerror ENOENT))
|
||||||
|
(len (strlen ptr))
|
||||||
|
(bv (foreign->bytevector ptr 'u8 0 len))
|
||||||
|
(str (utf8->string bv)))
|
||||||
|
(test #t (not (not (string-contains str "file")))))
|
||||||
|
|
||||||
;; Local Variables:
|
;; Local Variables:
|
||||||
;; mode: scheme
|
;; mode: scheme
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue