1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +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:
Ludovic Courtès 2010-03-17 00:51:22 +01:00
parent dd1464bf38
commit d12f974b43
3 changed files with 61 additions and 9 deletions

View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@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 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
with it.
@deffn {Scheme Procedure} dynamic-link library
@deffn {Scheme Procedure} dynamic-link [library]
@deffnx {C Function} scm_dynamic_link (library)
Find the shared library denoted by @var{library} (a string) and link it
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
that will be searched for in the places where shared libraries usually
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
@deffn {Scheme Procedure} dynamic-object? obj

View file

@ -77,16 +77,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;
}
@ -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),
"Find the shared object (shared library) denoted by\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"
"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

View file

@ -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))
(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:
;; mode: scheme