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/lang.h"
59 #include "libguile/validate.h"
60 #include "libguile/dynwind.h"
61 #include "libguile/foreign.h"
66 From the libtool manual: "Note that libltdl is not threadsafe,
67 i.e. a multithreaded application has to use a mutex for libltdl.".
69 Guile does not currently support pre-emptive threads, so there is no
70 mutex. Previously SCM_CRITICAL_SECTION_START and
71 SCM_CRITICAL_SECTION_END were used: they are mentioned here in case
72 somebody is grepping for thread problems ;)
74 /* njrev: not threadsafe, protection needed as described above */
77 sysdep_dynl_link (const char *fname
, const char *subr
)
80 handle
= lt_dlopenext (fname
);
86 fn
= scm_from_locale_string (fname
);
87 msg
= scm_from_locale_string (lt_dlerror ());
88 scm_misc_error (subr
, "file: ~S, message: ~S", scm_list_2 (fn
, msg
));
90 return (void *) handle
;
94 sysdep_dynl_unlink (void *handle
, const char *subr
)
96 if (lt_dlclose ((lt_dlhandle
) handle
))
98 scm_misc_error (subr
, (char *) lt_dlerror (), SCM_EOL
);
103 sysdep_dynl_value (const char *symb
, void *handle
, const char *subr
)
107 fptr
= lt_dlsym ((lt_dlhandle
) handle
, symb
);
110 scm_misc_error (subr
, (char *) lt_dlerror (), SCM_EOL
);
122 env
= getenv ("GUILE_SYSTEM_EXTENSIONS_PATH");
123 if (env
&& strcmp (env
, "") == 0)
124 /* special-case interpret system-ltdl-path=="" as meaning no system path,
125 which is the case during the build */
128 /* FIXME: should this be a colon-separated path? Or is the only point to
129 allow the build system to turn off the installed extensions path? */
130 lt_dladdsearchdir (env
);
133 lt_dladdsearchdir (SCM_LIB_DIR
);
134 lt_dladdsearchdir (SCM_EXTENSIONS_DIR
);
138 scm_t_bits scm_tc16_dynamic_obj
;
140 #define DYNL_FILENAME SCM_SMOB_OBJECT
141 #define DYNL_HANDLE(x) ((void *) SCM_SMOB_DATA_2 (x))
142 #define SET_DYNL_HANDLE(x, v) (SCM_SET_SMOB_DATA_2 ((x), (scm_t_bits) (v)))
147 dynl_obj_print (SCM exp
, SCM port
, scm_print_state
*pstate
)
149 scm_puts ("#<dynamic-object ", port
);
150 scm_iprin1 (DYNL_FILENAME (exp
), port
, pstate
);
151 if (DYNL_HANDLE (exp
) == NULL
)
152 scm_puts (" (unlinked)", port
);
153 scm_putc ('>', port
);
158 SCM_DEFINE (scm_dynamic_link
, "dynamic-link", 1, 0, 0,
160 "Find the shared object (shared library) denoted by\n"
161 "@var{filename} and link it into the running Guile\n"
162 "application. The returned\n"
163 "scheme object is a ``handle'' for the library which can\n"
164 "be passed to @code{dynamic-func}, @code{dynamic-call} etc.\n\n"
165 "Searching for object files is system dependent. Normally,\n"
166 "if @var{filename} does have an explicit directory it will\n"
167 "be searched for in locations\n"
168 "such as @file{/usr/lib} and @file{/usr/local/lib}.")
169 #define FUNC_NAME s_scm_dynamic_link
174 scm_dynwind_begin (0);
175 file
= scm_to_locale_string (filename
);
176 scm_dynwind_free (file
);
177 handle
= sysdep_dynl_link (file
, FUNC_NAME
);
179 SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj
, SCM_UNPACK (filename
), handle
);
184 SCM_DEFINE (scm_dynamic_object_p
, "dynamic-object?", 1, 0, 0,
186 "Return @code{#t} if @var{obj} is a dynamic object handle,\n"
187 "or @code{#f} otherwise.")
188 #define FUNC_NAME s_scm_dynamic_object_p
190 return scm_from_bool (SCM_TYP16_PREDICATE (scm_tc16_dynamic_obj
, obj
));
195 SCM_DEFINE (scm_dynamic_unlink
, "dynamic-unlink", 1, 0, 0,
197 "Unlink a dynamic object from the application, if possible. The\n"
198 "object must have been linked by @code{dynamic-link}, with \n"
199 "@var{dobj} the corresponding handle. After this procedure\n"
200 "is called, the handle can no longer be used to access the\n"
202 #define FUNC_NAME s_scm_dynamic_unlink
204 /*fixme* GC-problem */
205 SCM_VALIDATE_SMOB (SCM_ARG1
, dobj
, dynamic_obj
);
206 if (DYNL_HANDLE (dobj
) == NULL
) {
207 SCM_MISC_ERROR ("Already unlinked: ~S", scm_list_1 (dobj
));
209 sysdep_dynl_unlink (DYNL_HANDLE (dobj
), FUNC_NAME
);
210 SET_DYNL_HANDLE (dobj
, NULL
);
211 return SCM_UNSPECIFIED
;
217 SCM_DEFINE (scm_dynamic_pointer
, "dynamic-pointer", 3, 1, 0,
218 (SCM name
, SCM type
, SCM dobj
, SCM len
),
219 "Return a ``handle'' for the pointer @var{name} in the\n"
220 "shared object referred to by @var{dobj}. The handle\n"
221 "aliases a C value, and is declared to be of type\n"
222 "@var{type}. Valid types are defined in the\n"
223 "@code{(system foreign)} module.\n\n"
224 "This facility works by asking the dynamic linker for\n"
225 "the address of a symbol, then assuming that it aliases a\n"
226 "value of a given type. Obviously, the user must be very\n"
227 "careful to ensure that the value actually is of the\n"
228 "declared type, or bad things will happen.\n\n"
229 "Regardless whether your C compiler prepends an underscore\n"
230 "@samp{_} to the global names in a program, you should\n"
231 "@strong{not} include this underscore in @var{name}\n"
232 "since it will be added automatically when necessary.")
233 #define FUNC_NAME s_scm_dynamic_pointer
236 scm_t_foreign_type t
;
238 SCM_VALIDATE_STRING (1, name
);
239 t
= scm_to_unsigned_integer (type
, 0, SCM_FOREIGN_TYPE_LAST
);
240 SCM_VALIDATE_SMOB (SCM_ARG3
, dobj
, dynamic_obj
);
242 if (DYNL_HANDLE (dobj
) == NULL
)
243 SCM_MISC_ERROR ("Already unlinked: ~S", dobj
);
248 scm_dynwind_begin (0);
249 chars
= scm_to_locale_string (name
);
250 scm_dynwind_free (chars
);
251 val
= sysdep_dynl_value (chars
, DYNL_HANDLE (dobj
), FUNC_NAME
);
254 return scm_take_foreign_pointer (t
, val
,
255 SCM_UNBNDP (len
) ? 0 : scm_to_size_t (len
),
262 SCM_DEFINE (scm_dynamic_func
, "dynamic-func", 2, 0, 0,
263 (SCM name
, SCM dobj
),
264 "Return a ``handle'' for the function @var{name} in the\n"
265 "shared object referred to by @var{dobj}. The handle\n"
266 "can be passed to @code{dynamic-call} to actually\n"
267 "call the function.\n\n"
268 "Regardless whether your C compiler prepends an underscore\n"
269 "@samp{_} to the global names in a program, you should\n"
270 "@strong{not} include this underscore in @var{name}\n"
271 "since it will be added automatically when necessary.")
272 #define FUNC_NAME s_scm_dynamic_func
274 return scm_dynamic_pointer (name
,
275 scm_from_uint (SCM_FOREIGN_TYPE_VOID
),
282 SCM_DEFINE (scm_dynamic_call
, "dynamic-call", 2, 0, 0,
283 (SCM func
, SCM dobj
),
284 "Call a C function in a dynamic object. Two styles of\n"
285 "invocation are supported:\n\n"
287 "@item @var{func} can be a function handle returned by\n"
288 "@code{dynamic-func}. In this case @var{dobj} is\n"
290 "@item @var{func} can be a string with the name of the\n"
291 "function to call, with @var{dobj} the handle of the\n"
292 "dynamic object in which to find the function.\n"
293 "This is equivalent to\n"
295 "(dynamic-call (dynamic-func @var{func} @var{dobj}) #f)\n"
296 "@end smallexample\n"
298 "In either case, the function is passed no arguments\n"
299 "and its return value is ignored.")
300 #define FUNC_NAME s_scm_dynamic_call
304 if (scm_is_string (func
))
305 func
= scm_dynamic_func (func
, dobj
);
306 SCM_VALIDATE_FOREIGN_TYPED (SCM_ARG1
, func
, VOID
);
308 fptr
= SCM_FOREIGN_POINTER (func
, void);
310 return SCM_UNSPECIFIED
;
314 SCM_DEFINE (scm_dynamic_args_call
, "dynamic-args-call", 3, 0, 0,
315 (SCM func
, SCM dobj
, SCM args
),
316 "Call the C function indicated by @var{func} and @var{dobj},\n"
317 "just like @code{dynamic-call}, but pass it some arguments and\n"
318 "return its return value. The C function is expected to take\n"
319 "two arguments and return an @code{int}, just like @code{main}:\n"
321 "int c_func (int argc, char **argv);\n"
322 "@end smallexample\n\n"
323 "The parameter @var{args} must be a list of strings and is\n"
324 "converted into an array of @code{char *}. The array is passed\n"
325 "in @var{argv} and its size in @var{argc}. The return value is\n"
326 "converted to a Scheme number and returned from the call to\n"
327 "@code{dynamic-args-call}.")
328 #define FUNC_NAME s_scm_dynamic_args_call
330 int (*fptr
) (int argc
, char **argv
);
334 if (scm_is_string (func
))
335 func
= scm_dynamic_func (func
, dobj
);
336 SCM_VALIDATE_FOREIGN_TYPED (SCM_ARG1
, func
, VOID
);
338 fptr
= SCM_FOREIGN_POINTER (func
, void);
340 argv
= scm_i_allocate_string_pointers (args
);
341 for (argc
= 0; argv
[argc
]; argc
++)
343 result
= (*fptr
) (argc
, argv
);
345 return scm_from_int (result
);
350 scm_init_dynamic_linking ()
352 scm_tc16_dynamic_obj
= scm_make_smob_type ("dynamic-object", 0);
353 scm_set_smob_print (scm_tc16_dynamic_obj
, dynl_obj_print
);
355 #include "libguile/dynl.x"