1 /* dynl.c - dynamic linking
3 * Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002,
4 * 2003 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
8 * License as published by the Free Software Foundation; either
9 * version 2.1 of the License, or (at your option) any later version.
11 * This library is distributed in the hope that it will be useful,
12 * but 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23 /* "dynl.c" dynamically link&load object files.
25 Modified for libguile by Marius Vollmer */
27 #if 0 /* Disabled until we know for sure that it isn't needed */
28 /* XXX - This is only here to drag in a definition of __eprintf. This
29 is needed for proper operation of dynamic linking. The real
30 solution would probably be a shared libgcc. */
36 maybe_drag_in_eprintf ()
38 assert (!maybe_drag_in_eprintf
);
45 #include "libguile/_scm.h"
46 #include "libguile/dynl.h"
47 #include "libguile/smob.h"
48 #include "libguile/keywords.h"
49 #include "libguile/ports.h"
50 #include "libguile/strings.h"
51 #include "libguile/deprecation.h"
52 #include "libguile/lang.h"
53 #include "libguile/validate.h"
55 #include "guile-ltdl.h"
58 From the libtool manual: "Note that libltdl is not threadsafe,
59 i.e. a multithreaded application has to use a mutex for libltdl.".
61 Guile does not currently support pre-emptive threads, so there is
62 no mutex. Previously SCM_DEFER_INTS and SCM_ALLOW_INTS were used:
63 they are mentioned here in case somebody is grepping for thread
68 sysdep_dynl_link (const char *fname
, const char *subr
)
70 scm_lt_dlhandle handle
;
71 handle
= scm_lt_dlopenext (fname
);
77 fn
= scm_makfrom0str (fname
);
78 msg
= scm_makfrom0str (scm_lt_dlerror ());
79 scm_misc_error (subr
, "file: ~S, message: ~S", scm_list_2 (fn
, msg
));
81 return (void *) handle
;
85 sysdep_dynl_unlink (void *handle
, const char *subr
)
87 if (scm_lt_dlclose ((scm_lt_dlhandle
) handle
))
89 scm_misc_error (subr
, (char *) scm_lt_dlerror (), SCM_EOL
);
94 sysdep_dynl_func (const char *symb
, void *handle
, const char *subr
)
98 fptr
= scm_lt_dlsym ((scm_lt_dlhandle
) handle
, symb
);
101 scm_misc_error (subr
, (char *) scm_lt_dlerror (), SCM_EOL
);
112 scm_t_bits scm_tc16_dynamic_obj
;
114 #define DYNL_FILENAME SCM_SMOB_OBJECT
115 #define DYNL_HANDLE(x) ((void *) SCM_SMOB_DATA_2 (x))
116 #define SET_DYNL_HANDLE(x, v) (SCM_SET_SMOB_DATA_2 ((x), (scm_t_bits) (v)))
120 dynl_obj_mark (SCM ptr
)
122 return DYNL_FILENAME (ptr
);
127 dynl_obj_print (SCM exp
, SCM port
, scm_print_state
*pstate
)
129 scm_puts ("#<dynamic-object ", port
);
130 scm_iprin1 (DYNL_FILENAME (exp
), port
, pstate
);
131 if (DYNL_HANDLE (exp
) == NULL
)
132 scm_puts (" (unlinked)", port
);
133 scm_putc ('>', port
);
138 SCM_DEFINE (scm_dynamic_link
, "dynamic-link", 1, 0, 0,
140 "Find the shared object (shared library) denoted by\n"
141 "@var{filename} and link it into the running Guile\n"
142 "application. The returned\n"
143 "scheme object is a ``handle'' for the library which can\n"
144 "be passed to @code{dynamic-func}, @code{dynamic-call} etc.\n\n"
145 "Searching for object files is system dependent. Normally,\n"
146 "if @var{filename} does have an explicit directory it will\n"
147 "be searched for in locations\n"
148 "such as @file{/usr/lib} and @file{/usr/local/lib}.")
149 #define FUNC_NAME s_scm_dynamic_link
153 SCM_VALIDATE_STRING (1, filename
);
154 handle
= sysdep_dynl_link (SCM_STRING_CHARS (filename
), FUNC_NAME
);
155 SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj
, SCM_UNPACK (filename
), handle
);
160 SCM_DEFINE (scm_dynamic_object_p
, "dynamic-object?", 1, 0, 0,
162 "Return @code{#t} if @var{obj} is a dynamic object handle,\n"
163 "or @code{#f} otherwise.")
164 #define FUNC_NAME s_scm_dynamic_object_p
166 return SCM_BOOL (SCM_TYP16_PREDICATE (scm_tc16_dynamic_obj
, obj
));
171 SCM_DEFINE (scm_dynamic_unlink
, "dynamic-unlink", 1, 0, 0,
173 "Unlink a dynamic object from the application, if possible. The\n"
174 "object must have been linked by @code{dynamic-link}, with \n"
175 "@var{dobj} the corresponding handle. After this procedure\n"
176 "is called, the handle can no longer be used to access the\n"
178 #define FUNC_NAME s_scm_dynamic_unlink
180 /*fixme* GC-problem */
181 SCM_VALIDATE_SMOB (SCM_ARG1
, dobj
, dynamic_obj
);
182 if (DYNL_HANDLE (dobj
) == NULL
) {
183 SCM_MISC_ERROR ("Already unlinked: ~S", scm_list_1 (dobj
));
185 sysdep_dynl_unlink (DYNL_HANDLE (dobj
), FUNC_NAME
);
186 SET_DYNL_HANDLE (dobj
, NULL
);
187 return SCM_UNSPECIFIED
;
193 SCM_DEFINE (scm_dynamic_func
, "dynamic-func", 2, 0, 0,
194 (SCM name
, SCM dobj
),
195 "Return a ``handle'' for the function @var{name} in the\n"
196 "shared object referred to by @var{dobj}. The handle\n"
197 "can be passed to @code{dynamic-call} to actually\n"
198 "call the function.\n\n"
199 "Regardless whether your C compiler prepends an underscore\n"
200 "@samp{_} to the global names in a program, you should\n"
201 "@strong{not} include this underscore in @var{name}\n"
202 "since it will be added automatically when necessary.")
203 #define FUNC_NAME s_scm_dynamic_func
205 /* The returned handle is formed by casting the address of the function to a
206 * long value and converting this to a scheme number
211 SCM_VALIDATE_STRING (1, name
);
212 /*fixme* GC-problem */
213 SCM_VALIDATE_SMOB (SCM_ARG2
, dobj
, dynamic_obj
);
214 if (DYNL_HANDLE (dobj
) == NULL
) {
215 SCM_MISC_ERROR ("Already unlinked: ~S", dobj
);
219 chars
= SCM_STRING_CHARS (name
);
220 func
= (void (*) ()) sysdep_dynl_func (chars
, DYNL_HANDLE (dobj
), FUNC_NAME
);
221 return scm_ulong2num ((unsigned long) func
);
227 SCM_DEFINE (scm_dynamic_call
, "dynamic-call", 2, 0, 0,
228 (SCM func
, SCM dobj
),
229 "Call a C function in a dynamic object. Two styles of\n"
230 "invocation are supported:\n\n"
232 "@item @var{func} can be a function handle returned by\n"
233 "@code{dynamic-func}. In this case @var{dobj} is\n"
235 "@item @var{func} can be a string with the name of the\n"
236 "function to call, with @var{dobj} the handle of the\n"
237 "dynamic object in which to find the function.\n"
238 "This is equivalent to\n"
240 "(dynamic-call (dynamic-func @var{func} @var{dobj}) #f)\n"
241 "@end smallexample\n"
243 "In either case, the function is passed no arguments\n"
244 "and its return value is ignored.")
245 #define FUNC_NAME s_scm_dynamic_call
249 if (SCM_STRINGP (func
))
250 func
= scm_dynamic_func (func
, dobj
);
251 fptr
= (void (*) ()) SCM_NUM2ULONG (1, func
);
253 return SCM_UNSPECIFIED
;
257 /* return a newly allocated array of char pointers to each of the strings
258 in args, with a terminating NULL pointer. */
259 /* Note: a similar function is defined in posix.c, but we don't necessarily
260 want to export it. */
261 static char **allocate_string_pointers (SCM args
, int *num_args_return
)
264 int n_args
= scm_ilength (args
);
267 SCM_ASSERT (n_args
>= 0, args
, SCM_ARGn
, "allocate_string_pointers");
268 result
= (char **) scm_malloc ((n_args
+ 1) * sizeof (char *));
269 result
[n_args
] = NULL
;
270 for (i
= 0; i
< n_args
; i
++)
272 SCM car
= SCM_CAR (args
);
274 if (!SCM_STRINGP (car
))
277 scm_wrong_type_arg ("allocate_string_pointers", SCM_ARGn
, car
);
279 result
[i
] = SCM_STRING_CHARS (SCM_CAR (args
));
280 args
= SCM_CDR (args
);
282 *num_args_return
= n_args
;
286 SCM_DEFINE (scm_dynamic_args_call
, "dynamic-args-call", 3, 0, 0,
287 (SCM func
, SCM dobj
, SCM args
),
288 "Call the C function indicated by @var{func} and @var{dobj},\n"
289 "just like @code{dynamic-call}, but pass it some arguments and\n"
290 "return its return value. The C function is expected to take\n"
291 "two arguments and return an @code{int}, just like @code{main}:\n"
293 "int c_func (int argc, char **argv);\n"
294 "@end smallexample\n\n"
295 "The parameter @var{args} must be a list of strings and is\n"
296 "converted into an array of @code{char *}. The array is passed\n"
297 "in @var{argv} and its size in @var{argc}. The return value is\n"
298 "converted to a Scheme number and returned from the call to\n"
299 "@code{dynamic-args-call}.")
300 #define FUNC_NAME s_scm_dynamic_args_call
302 int (*fptr
) (int argc
, char **argv
);
306 if (SCM_STRINGP (func
))
307 func
= scm_dynamic_func (func
, dobj
);
309 fptr
= (int (*) (int, char **)) SCM_NUM2ULONG (1, func
);
310 argv
= allocate_string_pointers (args
, &argc
);
311 /* if the procedure mutates its arguments, the original strings will be
312 changed -- in Guile 1.6 and earlier, this wasn't the case since a
313 new copy of each string was allocated. */
314 result
= (*fptr
) (argc
, argv
);
317 return SCM_MAKINUM (0L + result
);
322 scm_init_dynamic_linking ()
324 scm_tc16_dynamic_obj
= scm_make_smob_type ("dynamic-object", 0);
325 scm_set_smob_mark (scm_tc16_dynamic_obj
, dynl_obj_mark
);
326 scm_set_smob_print (scm_tc16_dynamic_obj
, dynl_obj_print
);
328 #include "libguile/dynl.x"