75 |
#include "libguile/lang.h" |
#include "libguile/lang.h" |
76 |
#include "libguile/validate.h" |
#include "libguile/validate.h" |
77 |
|
|
|
/* Dispatch to the system dependent files |
|
|
* |
|
|
* They define some static functions. These functions are called with |
|
|
* deferred interrupts. When they want to throw errors, they are |
|
|
* expected to insert a SCM_ALLOW_INTS before doing the throw. It |
|
|
* might work to throw an error while interrupts are deferred (because |
|
|
* they will be unconditionally allowed the next time a SCM_ALLOW_INTS |
|
|
* is executed, SCM_DEFER_INTS and SCM_ALLOW_INTS do not nest). |
|
|
*/ |
|
|
|
|
78 |
#ifdef DYNAMIC_LINKING |
#ifdef DYNAMIC_LINKING |
79 |
|
|
80 |
#include "libltdl/ltdl.h" |
#include "libltdl/ltdl.h" |
81 |
|
|
82 |
|
/* From the libtool manual: "Note that libltdl is not threadsafe, |
83 |
|
i.e. a multithreaded application has to use a mutex for libltdl.". |
84 |
|
|
85 |
|
Guile does not currently support pre-emptive threads, so there is |
86 |
|
no mutex. Previously SCM_DEFER_INTS and SCM_ALLOW_INTS were used: |
87 |
|
they are mentioned here in case somebody is grepping for thread |
88 |
|
problems ;) |
89 |
|
*/ |
90 |
|
|
91 |
static void * |
static void * |
92 |
sysdep_dynl_link (const char *fname, const char *subr) |
sysdep_dynl_link (const char *fname, const char *subr) |
93 |
{ |
{ |
98 |
SCM fn; |
SCM fn; |
99 |
SCM msg; |
SCM msg; |
100 |
|
|
|
SCM_ALLOW_INTS; |
|
101 |
fn = scm_makfrom0str (fname); |
fn = scm_makfrom0str (fname); |
102 |
msg = scm_makfrom0str (lt_dlerror ()); |
msg = scm_makfrom0str (lt_dlerror ()); |
103 |
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)); |
110 |
{ |
{ |
111 |
if (lt_dlclose ((lt_dlhandle) handle)) |
if (lt_dlclose ((lt_dlhandle) handle)) |
112 |
{ |
{ |
|
SCM_ALLOW_INTS; |
|
113 |
scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL); |
scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL); |
114 |
} |
} |
115 |
} |
} |
122 |
fptr = lt_dlsym ((lt_dlhandle) handle, symb); |
fptr = lt_dlsym ((lt_dlhandle) handle, symb); |
123 |
if (!fptr) |
if (!fptr) |
124 |
{ |
{ |
|
SCM_ALLOW_INTS; |
|
125 |
scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL); |
scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL); |
126 |
} |
} |
127 |
return fptr; |
return fptr; |
145 |
static void |
static void |
146 |
no_dynl_error (const char *subr) |
no_dynl_error (const char *subr) |
147 |
{ |
{ |
|
SCM_ALLOW_INTS; |
|
148 |
scm_misc_error (subr, "dynamic linking not available", SCM_EOL); |
scm_misc_error (subr, "dynamic linking not available", SCM_EOL); |
149 |
} |
} |
150 |
|
|
240 |
if (DYNL_HANDLE (dobj) == NULL) { |
if (DYNL_HANDLE (dobj) == NULL) { |
241 |
SCM_MISC_ERROR ("Already unlinked: ~S", dobj); |
SCM_MISC_ERROR ("Already unlinked: ~S", dobj); |
242 |
} else { |
} else { |
|
SCM_DEFER_INTS; |
|
243 |
sysdep_dynl_unlink (DYNL_HANDLE (dobj), FUNC_NAME); |
sysdep_dynl_unlink (DYNL_HANDLE (dobj), FUNC_NAME); |
244 |
SET_DYNL_HANDLE (dobj, NULL); |
SET_DYNL_HANDLE (dobj, NULL); |
|
SCM_ALLOW_INTS; |
|
245 |
return SCM_UNSPECIFIED; |
return SCM_UNSPECIFIED; |
246 |
} |
} |
247 |
} |
} |
274 |
} else { |
} else { |
275 |
char *chars; |
char *chars; |
276 |
|
|
|
SCM_DEFER_INTS; |
|
277 |
chars = SCM_STRING_CHARS (name); |
chars = SCM_STRING_CHARS (name); |
278 |
func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj), FUNC_NAME); |
func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj), FUNC_NAME); |
|
SCM_ALLOW_INTS; |
|
279 |
return scm_ulong2num ((unsigned long) func); |
return scm_ulong2num ((unsigned long) func); |
280 |
} |
} |
281 |
} |
} |
292 |
"is equivalent to\n" |
"is equivalent to\n" |
293 |
"@smallexample\n" |
"@smallexample\n" |
294 |
"(dynamic-call (dynamic-func @var{func} @var{dobj} #f))\n" |
"(dynamic-call (dynamic-func @var{func} @var{dobj} #f))\n" |
295 |
"@end smallexample\n\n" |
"@end smallexample\n\n") |
|
"Interrupts are deferred while the C function is executing (with\n" |
|
|
"@code{SCM_DEFER_INTS}/@code{SCM_ALLOW_INTS}).") |
|
296 |
#define FUNC_NAME s_scm_dynamic_call |
#define FUNC_NAME s_scm_dynamic_call |
297 |
{ |
{ |
298 |
void (*fptr) (); |
void (*fptr) (); |
300 |
if (SCM_STRINGP (func)) |
if (SCM_STRINGP (func)) |
301 |
func = scm_dynamic_func (func, dobj); |
func = scm_dynamic_func (func, dobj); |
302 |
fptr = (void (*) ()) SCM_NUM2ULONG (1, func); |
fptr = (void (*) ()) SCM_NUM2ULONG (1, func); |
|
SCM_DEFER_INTS; |
|
303 |
fptr (); |
fptr (); |
|
SCM_ALLOW_INTS; |
|
304 |
return SCM_UNSPECIFIED; |
return SCM_UNSPECIFIED; |
305 |
} |
} |
306 |
#undef FUNC_NAME |
#undef FUNC_NAME |
358 |
func = scm_dynamic_func (func, dobj); |
func = scm_dynamic_func (func, dobj); |
359 |
|
|
360 |
fptr = (int (*) (int, char **)) SCM_NUM2ULONG (1, func); |
fptr = (int (*) (int, char **)) SCM_NUM2ULONG (1, func); |
|
SCM_DEFER_INTS; |
|
361 |
argv = allocate_string_pointers (args, &argc); |
argv = allocate_string_pointers (args, &argc); |
362 |
/* if the procedure mutates its arguments, the original strings will be |
/* if the procedure mutates its arguments, the original strings will be |
363 |
changed -- in Guile 1.6 and earlier, this wasn't the case since a |
changed -- in Guile 1.6 and earlier, this wasn't the case since a |
364 |
new copy of each string was allocated. */ |
new copy of each string was allocated. */ |
365 |
result = (*fptr) (argc, argv); |
result = (*fptr) (argc, argv); |
366 |
free (argv); |
free (argv); |
|
SCM_ALLOW_INTS; |
|
367 |
|
|
368 |
return SCM_MAKINUM (0L + result); |
return SCM_MAKINUM (0L + result); |
369 |
} |
} |