diff options
Diffstat (limited to 'libguile/dynl.c')
-rw-r--r-- | libguile/dynl.c | 61 |
1 files changed, 45 insertions, 16 deletions
diff --git a/libguile/dynl.c b/libguile/dynl.c index a55ba86ea..0175c336a 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -100,7 +100,7 @@ sysdep_dynl_unlink (void *handle, const char *subr) } static void * -sysdep_dynl_func (const char *symb, void *handle, const char *subr) +sysdep_dynl_value (const char *symb, void *handle, const char *subr) { void *fptr; @@ -214,23 +214,31 @@ SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0, #undef FUNC_NAME -SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0, - (SCM name, SCM dobj), - "Return a ``handle'' for the function @var{name} in the\n" +SCM_DEFINE (scm_dynamic_pointer, "dynamic-pointer", 3, 1, 0, + (SCM name, SCM type, SCM dobj, SCM len), + "Return a ``handle'' for the pointer @var{name} in the\n" "shared object referred to by @var{dobj}. The handle\n" - "can be passed to @code{dynamic-call} to actually\n" - "call the function.\n\n" + "aliases a C value, and is declared to be of type\n" + "@var{type}. Valid types are defined in the\n" + "@code{(system vm ffi)} module.\n\n" + "This facility works by asking the operating system for\n" + "the address of a symbol, then assuming that it aliases a\n" + "value of a given type. Obviously, the user must be very\n" + "careful to ensure that the value actually is of the\n" + "declared type, or bad things will happen.\n\n" "Regardless whether your C compiler prepends an underscore\n" "@samp{_} to the global names in a program, you should\n" "@strong{not} include this underscore in @var{name}\n" "since it will be added automatically when necessary.") -#define FUNC_NAME s_scm_dynamic_func +#define FUNC_NAME s_scm_dynamic_pointer { - void (*func) (); + void *val; + scm_t_foreign_type t; SCM_VALIDATE_STRING (1, name); + t = scm_to_unsigned_integer (type, 0, SCM_FOREIGN_TYPE_LAST); /*fixme* GC-problem */ - SCM_VALIDATE_SMOB (SCM_ARG2, dobj, dynamic_obj); + SCM_VALIDATE_SMOB (SCM_ARG3, dobj, dynamic_obj); if (DYNL_HANDLE (dobj) == NULL) { SCM_MISC_ERROR ("Already unlinked: ~S", dobj); } else { @@ -239,15 +247,36 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0, scm_dynwind_begin (0); chars = scm_to_locale_string (name); scm_dynwind_free (chars); - func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj), - FUNC_NAME); + val = sysdep_dynl_value (chars, DYNL_HANDLE (dobj), FUNC_NAME); scm_dynwind_end (); - return scm_c_from_foreign (SCM_FOREIGN_TYPE_POINTER, &func, 0, NULL); + return scm_take_foreign_pointer (t, val, + SCM_UNBNDP (len) ? 0 : scm_to_size_t (len), + NULL); } } #undef FUNC_NAME +SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0, + (SCM name, SCM dobj), + "Return a ``handle'' for the function @var{name} in the\n" + "shared object referred to by @var{dobj}. The handle\n" + "can be passed to @code{dynamic-call} to actually\n" + "call the function.\n\n" + "Regardless whether your C compiler prepends an underscore\n" + "@samp{_} to the global names in a program, you should\n" + "@strong{not} include this underscore in @var{name}\n" + "since it will be added automatically when necessary.") +#define FUNC_NAME s_scm_dynamic_func +{ + return scm_dynamic_pointer (name, + scm_from_uint (SCM_FOREIGN_TYPE_VOID), + dobj, + SCM_UNDEFINED); +} +#undef FUNC_NAME + + SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0, (SCM func, SCM dobj), "Call a C function in a dynamic object. Two styles of\n" @@ -272,9 +301,9 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0, if (scm_is_string (func)) func = scm_dynamic_func (func, dobj); - SCM_VALIDATE_FOREIGN_TYPED (SCM_ARG1, func, POINTER); + SCM_VALIDATE_FOREIGN_TYPED (SCM_ARG1, func, VOID); - fptr = SCM_FOREIGN_OBJECT_REF (func, void*); + fptr = SCM_FOREIGN_POINTER (func, void); fptr (); return SCM_UNSPECIFIED; } @@ -302,9 +331,9 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0, if (scm_is_string (func)) func = scm_dynamic_func (func, dobj); - SCM_VALIDATE_FOREIGN_TYPED (SCM_ARG1, func, POINTER); + SCM_VALIDATE_FOREIGN_TYPED (SCM_ARG1, func, VOID); - fptr = SCM_FOREIGN_OBJECT_REF (func, void*); + fptr = SCM_FOREIGN_POINTER (func, void); argv = scm_i_allocate_string_pointers (args); for (argc = 0; argv[argc]; argc++) |