mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Simplify the (system foreign) API.
Suggested by Neil Jerram. * libguile/foreign.h (SCM_FOREIGN_TYPE, SCM_FOREIGN_VALUE_REF, SCM_FOREIGN_VALUE_SET, SCM_FOREIGN_LEN, SCM_FOREIGN_TYPED_P, SCM_FOREIGN_VALUE_P, SCM_VALIDATE_FOREIGN_VALUE, scm_foreign_set_x, scm_foreign_type): Remove. (scm_foreign_ref): Rename to... (scm_foreign_address): ... this. (scm_take_foreign_pointer): Update. (SCM_FOREIGN_POINTER): Remove CTYPE argument. Update callers. (scm_make_pointer): New declaration. * libguile/foreign.c (scm_to_uintptr, scm_from_uintptr): New macros. (scm_make_pointer): New function. (scm_take_foreign_pointer): Remove TYPE and LEN arguments. Update callers. (scm_foreign_ref): Remove to... (scm_foreign_address): ... this. Remove type-related code. (scm_foreign_set_x): Remove. (scm_foreign_to_bytevector): Change argument order; make LEN argument compulsory. (scm_i_foreign_print): Remove type printing. (unpack): Remove foreign-type checking. * libguile/deprecated.c (scm_dynamic_args_call): Update accordingly. * libguile/dynl.c (scm_dynamic_pointer): Remove the TYPE and LEN arguments; update callers. Update to the new foreign API. * libguile/dynl.h (scm_dynamic_pointer): Update. * libguile/gsubr.c (create_gsubr): Update to the new foreign API. * libguile/gsubr.h (SCM_SUBRF, SCM_SUBR_GENERIC): Ditto. * libguile/snarf.h (SCM_IMMUTABLE_FOREIGN): Ditto. * libguile/vm-i-system.c (subr_call): Ditto. * module/system/foreign.scm (null-pointer?): New procedure. * test-suite/standalone/test-ffi: Update to the new `bytevector->foreign' signature. * test-suite/tests/foreign.test ("null pointer")["null pointer identity", "null-pointer? %null-pointer"]: New tests. ["foreign-set! other-null-pointer", "foreign->bytevector other-null-pointer"]: Remove. ("make-pointer", "foreign<->bytevector"): New test prefixes.
This commit is contained in:
parent
1af772303b
commit
d4149a510e
12 changed files with 176 additions and 307 deletions
|
@ -235,13 +235,11 @@ SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0,
|
|||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_dynamic_pointer, "dynamic-pointer", 3, 1, 0,
|
||||
(SCM name, SCM type, SCM dobj, SCM len),
|
||||
SCM_DEFINE (scm_dynamic_pointer, "dynamic-pointer", 2, 0, 0,
|
||||
(SCM name, SCM dobj),
|
||||
"Return a ``handle'' for the pointer @var{name} in the\n"
|
||||
"shared object referred to by @var{dobj}. The handle\n"
|
||||
"aliases a C value, and is declared to be of type\n"
|
||||
"@var{type}. Valid types are defined in the\n"
|
||||
"@code{(system foreign)} module.\n\n"
|
||||
"aliases a C object.\n\n"
|
||||
"This facility works by asking the dynamic linker 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"
|
||||
|
@ -254,11 +252,9 @@ SCM_DEFINE (scm_dynamic_pointer, "dynamic-pointer", 3, 1, 0,
|
|||
#define FUNC_NAME s_scm_dynamic_pointer
|
||||
{
|
||||
void *val;
|
||||
scm_t_foreign_type t;
|
||||
|
||||
SCM_VALIDATE_STRING (1, name);
|
||||
t = scm_to_unsigned_integer (type, 0, SCM_FOREIGN_TYPE_LAST);
|
||||
SCM_VALIDATE_SMOB (SCM_ARG3, dobj, dynamic_obj);
|
||||
SCM_VALIDATE_SMOB (SCM_ARG2, dobj, dynamic_obj);
|
||||
|
||||
if (DYNL_HANDLE (dobj) == NULL)
|
||||
SCM_MISC_ERROR ("Already unlinked: ~S", dobj);
|
||||
|
@ -272,9 +268,7 @@ SCM_DEFINE (scm_dynamic_pointer, "dynamic-pointer", 3, 1, 0,
|
|||
val = sysdep_dynl_value (chars, DYNL_HANDLE (dobj), FUNC_NAME);
|
||||
scm_dynwind_end ();
|
||||
|
||||
return scm_take_foreign_pointer (t, val,
|
||||
SCM_UNBNDP (len) ? 0 : scm_to_size_t (len),
|
||||
NULL);
|
||||
return scm_take_foreign_pointer (val, NULL);
|
||||
}
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
@ -292,10 +286,7 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
|
|||
"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);
|
||||
return scm_dynamic_pointer (name, dobj);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
@ -324,9 +315,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, VOID);
|
||||
SCM_VALIDATE_FOREIGN (SCM_ARG1, func);
|
||||
|
||||
fptr = SCM_FOREIGN_POINTER (func, void);
|
||||
fptr = SCM_FOREIGN_POINTER (func);
|
||||
fptr ();
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue