1 /* dynl.c - dynamic linking
3 * Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002,
4 * 2003, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
6 * This library is free software; you can redistribute it and/or
7 * modify it under the terms of the GNU Lesser General Public License
8 * as published by the Free Software Foundation; either version 3 of
9 * the License, or (at your option) any later version.
11 * This library is distributed in the hope that it will be useful, but
12 * WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 * Lesser General Public License for more details.
16 * You should have received a copy of the GNU Lesser General Public
17 * License along with this library; if not, write to the Free Software
18 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
31 /* "dynl.c" dynamically link&load object files.
33 Modified for libguile by Marius Vollmer */
35 #if 0 /* Disabled until we know for sure that it isn't needed */
36 /* XXX - This is only here to drag in a definition of __eprintf. This
37 is needed for proper operation of dynamic linking. The real
38 solution would probably be a shared libgcc. */
44 maybe_drag_in_eprintf ()
46 assert (!maybe_drag_in_eprintf
);
54 #include "libguile/_scm.h"
55 #include "libguile/libpath.h"
56 #include "libguile/dynl.h"
57 #include "libguile/smob.h"
58 #include "libguile/keywords.h"
59 #include "libguile/ports.h"
60 #include "libguile/strings.h"
61 #include "libguile/deprecation.h"
62 #include "libguile/validate.h"
63 #include "libguile/dynwind.h"
64 #include "libguile/foreign.h"
65 #include "libguile/gc.h"
70 From the libtool manual: "Note that libltdl is not threadsafe,
71 i.e. a multithreaded application has to use a mutex for libltdl.".
73 Guile does not currently support pre-emptive threads, so there is no
74 mutex. Previously SCM_CRITICAL_SECTION_START and
75 SCM_CRITICAL_SECTION_END were used: they are mentioned here in case
76 somebody is grepping for thread problems ;)
78 /* njrev: not threadsafe, protection needed as described above */
81 /* LT_PATH_SEP-separated extension library search path, searched last */
82 static char *system_extensions_path
;
85 sysdep_dynl_link (const char *fname
, const char *subr
)
90 /* Return a handle for the program as a whole. */
91 handle
= lt_dlopen (NULL
);
94 handle
= lt_dlopenext (fname
);
98 && strchr (fname
, LT_DIRSEP_CHAR
) == NULL
100 && strchr (fname
, '/') == NULL
)
102 /* FNAME contains no directory separators and was not in the
103 usual library search paths, so now we search for it in
104 SYSTEM_EXTENSIONS_PATH. */
106 = scm_gc_malloc_pointerless (strlen (system_extensions_path
)
107 + strlen (fname
) + 2,
108 "dynl fname_attempt");
109 char *path
; /* remaining path to search */
110 char *end
; /* end of current path component */
113 /* Iterate over the components of SYSTEM_EXTENSIONS_PATH */
114 for (path
= system_extensions_path
;
116 path
= (*end
== '\0') ? end
: (end
+ 1))
118 /* Find end of path component */
119 end
= strchr (path
, LT_PATHSEP_CHAR
);
121 end
= strchr (path
, '\0');
123 /* Skip empty path components */
127 /* Construct FNAME_ATTEMPT, starting with path component */
129 memcpy (s
, path
, end
- path
);
132 /* Append directory separator, but avoid duplicates */
134 #ifdef LT_DIRSEP_CHAR
135 && s
[-1] != LT_DIRSEP_CHAR
140 /* Finally, append FNAME (including null terminator) */
143 /* Try to load it, and terminate the search if successful */
144 handle
= lt_dlopenext (fname_attempt
);
156 fn
= fname
!= NULL
? scm_from_locale_string (fname
) : SCM_BOOL_F
;
157 msg
= scm_from_locale_string (lt_dlerror ());
158 scm_misc_error (subr
, "file: ~S, message: ~S", scm_list_2 (fn
, msg
));
161 return (void *) handle
;
165 sysdep_dynl_unlink (void *handle
, const char *subr
)
167 if (lt_dlclose ((lt_dlhandle
) handle
))
169 scm_misc_error (subr
, (char *) lt_dlerror (), SCM_EOL
);
174 sysdep_dynl_value (const char *symb
, void *handle
, const char *subr
)
178 fptr
= lt_dlsym ((lt_dlhandle
) handle
, symb
);
180 scm_misc_error (subr
, "Symbol not found: ~a",
181 scm_list_1 (scm_from_locale_string (symb
)));
192 /* Initialize 'system_extensions_path' from
193 $GUILE_SYSTEM_EXTENSIONS_PATH, or if that's not set:
194 <SCM_LIB_DIR> <LT_PATHSEP_CHAR> <SCM_EXTENSIONS_DIR>.
196 'lt_dladdsearchdir' can't be used because it is searched before
197 the system-dependent search path, which is the one 'libtool
198 --mode=execute -dlopen' fiddles with (info "(libtool) Libltdl
200 <http://lists.gnu.org/archive/html/guile-devel/2010-11/msg00095.html>.
202 The environment variables $LTDL_LIBRARY_PATH and $LD_LIBRARY_PATH
203 can't be used because they would be propagated to subprocesses
204 which may cause problems for other programs. See
205 <http://lists.gnu.org/archive/html/guile-devel/2012-09/msg00037.html> */
207 env
= getenv ("GUILE_SYSTEM_EXTENSIONS_PATH");
209 system_extensions_path
= env
;
212 system_extensions_path
213 = scm_gc_malloc_pointerless (strlen (SCM_LIB_DIR
)
214 + strlen (SCM_EXTENSIONS_DIR
) + 2,
215 "system_extensions_path");
216 sprintf (system_extensions_path
, "%s%c%s",
217 SCM_LIB_DIR
, LT_PATHSEP_CHAR
, SCM_EXTENSIONS_DIR
);
221 scm_t_bits scm_tc16_dynamic_obj
;
223 #define DYNL_FILENAME SCM_SMOB_OBJECT
224 #define DYNL_HANDLE(x) ((void *) SCM_SMOB_DATA_2 (x))
225 #define SET_DYNL_HANDLE(x, v) (SCM_SET_SMOB_DATA_2 ((x), (scm_t_bits) (v)))
230 dynl_obj_print (SCM exp
, SCM port
, scm_print_state
*pstate
)
232 scm_puts_unlocked ("#<dynamic-object ", port
);
233 scm_iprin1 (DYNL_FILENAME (exp
), port
, pstate
);
234 if (DYNL_HANDLE (exp
) == NULL
)
235 scm_puts_unlocked (" (unlinked)", port
);
236 scm_putc_unlocked ('>', port
);
241 SCM_DEFINE (scm_dynamic_link
, "dynamic-link", 0, 1, 0,
243 "Find the shared object (shared library) denoted by\n"
244 "@var{filename} and link it into the running Guile\n"
245 "application. The returned\n"
246 "scheme object is a ``handle'' for the library which can\n"
247 "be passed to @code{dynamic-func}, @code{dynamic-call} etc.\n\n"
248 "Searching for object files is system dependent. Normally,\n"
249 "if @var{filename} does have an explicit directory it will\n"
250 "be searched for in locations\n"
251 "such as @file{/usr/lib} and @file{/usr/local/lib}.\n\n"
252 "When @var{filename} is omitted, a @dfn{global symbol handle} is\n"
253 "returned. This handle provides access to the symbols\n"
254 "available to the program at run-time, including those exported\n"
255 "by the program itself and the shared libraries already loaded.\n")
256 #define FUNC_NAME s_scm_dynamic_link
261 scm_dynwind_begin (0);
263 if (SCM_UNBNDP (filename
))
267 file
= scm_to_locale_string (filename
);
268 scm_dynwind_free (file
);
271 handle
= sysdep_dynl_link (file
, FUNC_NAME
);
274 SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj
,
275 SCM_UNBNDP (filename
)
276 ? SCM_UNPACK (SCM_BOOL_F
) : SCM_UNPACK (filename
),
282 SCM_DEFINE (scm_dynamic_object_p
, "dynamic-object?", 1, 0, 0,
284 "Return @code{#t} if @var{obj} is a dynamic object handle,\n"
285 "or @code{#f} otherwise.")
286 #define FUNC_NAME s_scm_dynamic_object_p
288 return scm_from_bool (SCM_TYP16_PREDICATE (scm_tc16_dynamic_obj
, obj
));
293 SCM_DEFINE (scm_dynamic_unlink
, "dynamic-unlink", 1, 0, 0,
295 "Unlink a dynamic object from the application, if possible. The\n"
296 "object must have been linked by @code{dynamic-link}, with \n"
297 "@var{dobj} the corresponding handle. After this procedure\n"
298 "is called, the handle can no longer be used to access the\n"
300 #define FUNC_NAME s_scm_dynamic_unlink
302 /*fixme* GC-problem */
303 SCM_VALIDATE_SMOB (SCM_ARG1
, dobj
, dynamic_obj
);
304 if (DYNL_HANDLE (dobj
) == NULL
) {
305 SCM_MISC_ERROR ("Already unlinked: ~S", scm_list_1 (dobj
));
307 sysdep_dynl_unlink (DYNL_HANDLE (dobj
), FUNC_NAME
);
308 SET_DYNL_HANDLE (dobj
, NULL
);
309 return SCM_UNSPECIFIED
;
315 SCM_DEFINE (scm_dynamic_pointer
, "dynamic-pointer", 2, 0, 0,
316 (SCM name
, SCM dobj
),
317 "Return a ``wrapped pointer'' to the symbol @var{name}\n"
318 "in the shared object referred to by @var{dobj}. The returned\n"
319 "pointer points to a C object.\n\n"
320 "Regardless whether your C compiler prepends an underscore\n"
321 "@samp{_} to the global names in a program, you should\n"
322 "@strong{not} include this underscore in @var{name}\n"
323 "since it will be added automatically when necessary.")
324 #define FUNC_NAME s_scm_dynamic_pointer
328 SCM_VALIDATE_STRING (1, name
);
329 SCM_VALIDATE_SMOB (SCM_ARG2
, dobj
, dynamic_obj
);
331 if (DYNL_HANDLE (dobj
) == NULL
)
332 SCM_MISC_ERROR ("Already unlinked: ~S", dobj
);
337 scm_dynwind_begin (0);
338 chars
= scm_to_locale_string (name
);
339 scm_dynwind_free (chars
);
340 val
= sysdep_dynl_value (chars
, DYNL_HANDLE (dobj
), FUNC_NAME
);
343 return scm_from_pointer (val
, NULL
);
349 SCM_DEFINE (scm_dynamic_func
, "dynamic-func", 2, 0, 0,
350 (SCM name
, SCM dobj
),
351 "Return a ``handle'' for the function @var{name} in the\n"
352 "shared object referred to by @var{dobj}. The handle\n"
353 "can be passed to @code{dynamic-call} to actually\n"
354 "call the function.\n\n"
355 "Regardless whether your C compiler prepends an underscore\n"
356 "@samp{_} to the global names in a program, you should\n"
357 "@strong{not} include this underscore in @var{name}\n"
358 "since it will be added automatically when necessary.")
359 #define FUNC_NAME s_scm_dynamic_func
361 return scm_dynamic_pointer (name
, dobj
);
366 SCM_DEFINE (scm_dynamic_call
, "dynamic-call", 2, 0, 0,
367 (SCM func
, SCM dobj
),
368 "Call a C function in a dynamic object. Two styles of\n"
369 "invocation are supported:\n\n"
371 "@item @var{func} can be a function handle returned by\n"
372 "@code{dynamic-func}. In this case @var{dobj} is\n"
374 "@item @var{func} can be a string with the name of the\n"
375 "function to call, with @var{dobj} the handle of the\n"
376 "dynamic object in which to find the function.\n"
377 "This is equivalent to\n"
379 "(dynamic-call (dynamic-func @var{func} @var{dobj}) #f)\n"
380 "@end smallexample\n"
382 "In either case, the function is passed no arguments\n"
383 "and its return value is ignored.")
384 #define FUNC_NAME s_scm_dynamic_call
388 if (scm_is_string (func
))
389 func
= scm_dynamic_func (func
, dobj
);
390 SCM_VALIDATE_POINTER (SCM_ARG1
, func
);
392 fptr
= SCM_POINTER_VALUE (func
);
394 return SCM_UNSPECIFIED
;
399 scm_init_dynamic_linking ()
401 scm_tc16_dynamic_obj
= scm_make_smob_type ("dynamic-object", 0);
402 scm_set_smob_print (scm_tc16_dynamic_obj
, dynl_obj_print
);
404 #include "libguile/dynl.x"