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 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
28 /* "dynl.c" dynamically link&load object files.
30 Modified for libguile by Marius Vollmer */
32 #if 0 /* Disabled until we know for sure that it isn't needed */
33 /* XXX - This is only here to drag in a definition of __eprintf. This
34 is needed for proper operation of dynamic linking. The real
35 solution would probably be a shared libgcc. */
41 maybe_drag_in_eprintf ()
43 assert (!maybe_drag_in_eprintf
);
50 #include "libguile/_scm.h"
51 #include "libguile/libpath.h"
52 #include "libguile/dynl.h"
53 #include "libguile/smob.h"
54 #include "libguile/keywords.h"
55 #include "libguile/ports.h"
56 #include "libguile/strings.h"
57 #include "libguile/deprecation.h"
58 #include "libguile/validate.h"
59 #include "libguile/dynwind.h"
60 #include "libguile/foreign.h"
65 From the libtool manual: "Note that libltdl is not threadsafe,
66 i.e. a multithreaded application has to use a mutex for libltdl.".
68 Guile does not currently support pre-emptive threads, so there is no
69 mutex. Previously SCM_CRITICAL_SECTION_START and
70 SCM_CRITICAL_SECTION_END were used: they are mentioned here in case
71 somebody is grepping for thread problems ;)
73 /* njrev: not threadsafe, protection needed as described above */
76 sysdep_dynl_link (const char *fname
, const char *subr
)
81 handle
= lt_dlopenext (fname
);
83 /* Return a handle for the program as a whole. */
84 handle
= lt_dlopen (NULL
);
91 fn
= fname
!= NULL
? scm_from_locale_string (fname
) : SCM_BOOL_F
;
92 msg
= scm_from_locale_string (lt_dlerror ());
93 scm_misc_error (subr
, "file: ~S, message: ~S", scm_list_2 (fn
, msg
));
96 return (void *) handle
;
100 sysdep_dynl_unlink (void *handle
, const char *subr
)
102 if (lt_dlclose ((lt_dlhandle
) handle
))
104 scm_misc_error (subr
, (char *) lt_dlerror (), SCM_EOL
);
109 sysdep_dynl_value (const char *symb
, void *handle
, const char *subr
)
113 fptr
= lt_dlsym ((lt_dlhandle
) handle
, symb
);
116 scm_misc_error (subr
, (char *) lt_dlerror (), SCM_EOL
);
128 env
= getenv ("GUILE_SYSTEM_EXTENSIONS_PATH");
129 if (env
&& strcmp (env
, "") == 0)
130 /* special-case interpret system-ltdl-path=="" as meaning no system path,
131 which is the case during the build */
134 /* FIXME: should this be a colon-separated path? Or is the only point to
135 allow the build system to turn off the installed extensions path? */
136 lt_dladdsearchdir (env
);
139 lt_dladdsearchdir (SCM_LIB_DIR
);
140 lt_dladdsearchdir (SCM_EXTENSIONS_DIR
);
144 scm_t_bits scm_tc16_dynamic_obj
;
146 #define DYNL_FILENAME SCM_SMOB_OBJECT
147 #define DYNL_HANDLE(x) ((void *) SCM_SMOB_DATA_2 (x))
148 #define SET_DYNL_HANDLE(x, v) (SCM_SET_SMOB_DATA_2 ((x), (scm_t_bits) (v)))
153 dynl_obj_print (SCM exp
, SCM port
, scm_print_state
*pstate
)
155 scm_puts ("#<dynamic-object ", port
);
156 scm_iprin1 (DYNL_FILENAME (exp
), port
, pstate
);
157 if (DYNL_HANDLE (exp
) == NULL
)
158 scm_puts (" (unlinked)", port
);
159 scm_putc ('>', port
);
164 SCM_DEFINE (scm_dynamic_link
, "dynamic-link", 0, 1, 0,
166 "Find the shared object (shared library) denoted by\n"
167 "@var{filename} and link it into the running Guile\n"
168 "application. The returned\n"
169 "scheme object is a ``handle'' for the library which can\n"
170 "be passed to @code{dynamic-func}, @code{dynamic-call} etc.\n\n"
171 "Searching for object files is system dependent. Normally,\n"
172 "if @var{filename} does have an explicit directory it will\n"
173 "be searched for in locations\n"
174 "such as @file{/usr/lib} and @file{/usr/local/lib}.\n\n"
175 "When @var{filename} is omitted, a @dfn{global symbol handle} is\n"
176 "returned. This handle provides access to the symbols\n"
177 "available to the program at run-time, including those exported\n"
178 "by the program itself and the shared libraries already loaded.\n")
179 #define FUNC_NAME s_scm_dynamic_link
184 scm_dynwind_begin (0);
186 if (SCM_UNBNDP (filename
))
190 file
= scm_to_locale_string (filename
);
191 scm_dynwind_free (file
);
194 handle
= sysdep_dynl_link (file
, FUNC_NAME
);
197 SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj
,
198 SCM_UNBNDP (filename
)
199 ? SCM_UNPACK (SCM_BOOL_F
) : SCM_UNPACK (filename
),
205 SCM_DEFINE (scm_dynamic_object_p
, "dynamic-object?", 1, 0, 0,
207 "Return @code{#t} if @var{obj} is a dynamic object handle,\n"
208 "or @code{#f} otherwise.")
209 #define FUNC_NAME s_scm_dynamic_object_p
211 return scm_from_bool (SCM_TYP16_PREDICATE (scm_tc16_dynamic_obj
, obj
));
216 SCM_DEFINE (scm_dynamic_unlink
, "dynamic-unlink", 1, 0, 0,
218 "Unlink a dynamic object from the application, if possible. The\n"
219 "object must have been linked by @code{dynamic-link}, with \n"
220 "@var{dobj} the corresponding handle. After this procedure\n"
221 "is called, the handle can no longer be used to access the\n"
223 #define FUNC_NAME s_scm_dynamic_unlink
225 /*fixme* GC-problem */
226 SCM_VALIDATE_SMOB (SCM_ARG1
, dobj
, dynamic_obj
);
227 if (DYNL_HANDLE (dobj
) == NULL
) {
228 SCM_MISC_ERROR ("Already unlinked: ~S", scm_list_1 (dobj
));
230 sysdep_dynl_unlink (DYNL_HANDLE (dobj
), FUNC_NAME
);
231 SET_DYNL_HANDLE (dobj
, NULL
);
232 return SCM_UNSPECIFIED
;
238 SCM_DEFINE (scm_dynamic_pointer
, "dynamic-pointer", 2, 0, 0,
239 (SCM name
, SCM dobj
),
240 "Return a ``wrapped pointer'' to the symbol @var{name}\n"
241 "in the shared object referred to by @var{dobj}. The returned\n"
242 "pointer points to a C object.\n\n"
243 "Regardless whether your C compiler prepends an underscore\n"
244 "@samp{_} to the global names in a program, you should\n"
245 "@strong{not} include this underscore in @var{name}\n"
246 "since it will be added automatically when necessary.")
247 #define FUNC_NAME s_scm_dynamic_pointer
251 SCM_VALIDATE_STRING (1, name
);
252 SCM_VALIDATE_SMOB (SCM_ARG2
, dobj
, dynamic_obj
);
254 if (DYNL_HANDLE (dobj
) == NULL
)
255 SCM_MISC_ERROR ("Already unlinked: ~S", dobj
);
260 scm_dynwind_begin (0);
261 chars
= scm_to_locale_string (name
);
262 scm_dynwind_free (chars
);
263 val
= sysdep_dynl_value (chars
, DYNL_HANDLE (dobj
), FUNC_NAME
);
266 return scm_from_pointer (val
, NULL
);
272 SCM_DEFINE (scm_dynamic_func
, "dynamic-func", 2, 0, 0,
273 (SCM name
, SCM dobj
),
274 "Return a ``handle'' for the function @var{name} in the\n"
275 "shared object referred to by @var{dobj}. The handle\n"
276 "can be passed to @code{dynamic-call} to actually\n"
277 "call the function.\n\n"
278 "Regardless whether your C compiler prepends an underscore\n"
279 "@samp{_} to the global names in a program, you should\n"
280 "@strong{not} include this underscore in @var{name}\n"
281 "since it will be added automatically when necessary.")
282 #define FUNC_NAME s_scm_dynamic_func
284 return scm_dynamic_pointer (name
, dobj
);
289 SCM_DEFINE (scm_dynamic_call
, "dynamic-call", 2, 0, 0,
290 (SCM func
, SCM dobj
),
291 "Call a C function in a dynamic object. Two styles of\n"
292 "invocation are supported:\n\n"
294 "@item @var{func} can be a function handle returned by\n"
295 "@code{dynamic-func}. In this case @var{dobj} is\n"
297 "@item @var{func} can be a string with the name of the\n"
298 "function to call, with @var{dobj} the handle of the\n"
299 "dynamic object in which to find the function.\n"
300 "This is equivalent to\n"
302 "(dynamic-call (dynamic-func @var{func} @var{dobj}) #f)\n"
303 "@end smallexample\n"
305 "In either case, the function is passed no arguments\n"
306 "and its return value is ignored.")
307 #define FUNC_NAME s_scm_dynamic_call
311 if (scm_is_string (func
))
312 func
= scm_dynamic_func (func
, dobj
);
313 SCM_VALIDATE_POINTER (SCM_ARG1
, func
);
315 fptr
= SCM_POINTER_VALUE (func
);
317 return SCM_UNSPECIFIED
;
322 scm_init_dynamic_linking ()
324 scm_tc16_dynamic_obj
= scm_make_smob_type ("dynamic-object", 0);
325 scm_set_smob_print (scm_tc16_dynamic_obj
, dynl_obj_print
);
327 #include "libguile/dynl.x"