1
Fork 0
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:
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 -*-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

View file

@ -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

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)) '(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