diff options
| -rw-r--r-- | ffi.c | 28 | ||||
| -rw-r--r-- | ffi.h | 3 | ||||
| -rw-r--r-- | share/txr/stdlib/ffi.tl | 6 | ||||
| -rw-r--r-- | txr.1 | 11 |
4 files changed, 34 insertions, 14 deletions
@@ -4653,6 +4653,7 @@ struct txr_ffi_call_desc { cnum nfixed, ntotal; val argtypes; val rettype; + val name; }; static struct txr_ffi_call_desc *ffi_call_desc(val obj) @@ -4672,7 +4673,8 @@ static void ffi_call_desc_print_op(val obj, val out, struct txr_ffi_call_desc *tfcd = ffi_call_desc(obj); put_string(lit("#<"), out); obj_print_impl(obj->co.cls, out, pretty, ctx); - format(out, lit(" ~s ~!~s>"), tfcd->rettype, tfcd->argtypes, nao); + format(out, lit("~s ~s ~!~s>"), tfcd->name, tfcd->rettype, + tfcd->argtypes, nao); } static void ffi_call_desc_destroy_op(val obj) @@ -4688,6 +4690,7 @@ static void ffi_call_desc_mark_op(val obj) struct txr_ffi_call_desc *tfcd = ffi_call_desc(obj); gc_mark(tfcd->argtypes); gc_mark(tfcd->rettype); + gc_mark(tfcd->name); } static struct cobj_ops ffi_call_desc_ops = @@ -4697,9 +4700,11 @@ static struct cobj_ops ffi_call_desc_ops = ffi_call_desc_mark_op, cobj_eq_hash_op); -val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes) +val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes, + val name_in) { - val self = lit("ffi-make-call-desc"); + val name = default_null_arg(name_in); + val self = if3(name, name, lit("ffi-make-call-desc")); cnum nf = c_num(default_arg(nfixed, zero), self); cnum nt = c_num(ntotal, self), i; struct txr_ffi_call_desc *tfcd = coerce(struct txr_ffi_call_desc *, @@ -4714,6 +4719,7 @@ val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes) tfcd->argtypes = argtypes; tfcd->rettype = rettype; tfcd->args = args; + tfcd->name = name; for (i = 0; i < nt; i++) { val type = pop(&argtypes); @@ -4753,8 +4759,9 @@ val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes) val ffi_call_wrap(val fptr, val ffi_call_desc, struct args *args) { - val self = lit("ffi-call"); - struct txr_ffi_call_desc *tfcd = ffi_call_desc_checked(self, ffi_call_desc); + val real_self = lit("ffi-call"); + struct txr_ffi_call_desc *tfcd = ffi_call_desc_checked(real_self, ffi_call_desc); + val self = if3(tfcd->name, tfcd->name, real_self); mem_t *fp = cptr_get(fptr); cnum n = tfcd->ntotal; void **values = convert(void **, alloca(sizeof *values * tfcd->ntotal)); @@ -4833,11 +4840,11 @@ val ffi_call_wrap(val fptr, val ffi_call_desc, struct args *args) static void ffi_closure_dispatch(ffi_cif *cif, void *cret, void *cargs[], void *clo) { - val self = lit("ffi-closure-dispatch"); val closure = coerce(val, clo); struct txr_ffi_closure *tfcl = ffi_closure_struct(closure); cnum i, nargs = tfcl->nparam; struct txr_ffi_call_desc *tfcd = tfcl->tfcd; + val self = if3(tfcd->name, tfcd->name, lit("ffi-closure-dispatch")); val types = tfcd->argtypes; val rtype = tfcd->rettype; struct txr_ffi_type *rtft = ffi_type_struct(rtype); @@ -4877,11 +4884,11 @@ static void ffi_closure_dispatch(ffi_cif *cif, void *cret, static void ffi_closure_dispatch_safe(ffi_cif *cif, void *cret, void *cargs[], void *clo) { - val self = lit("ffi-closure-dispatch-safe"); val closure = coerce(val, clo); struct txr_ffi_closure *tfcl = ffi_closure_struct(closure); cnum i, nargs = tfcl->nparam; struct txr_ffi_call_desc *tfcd = tfcl->tfcd; + val self = if3(tfcd->name, tfcd->name, lit("ffi-closure-dispatch-safe")); val types = tfcd->argtypes; val rtype = tfcd->rettype; struct txr_ffi_type *rtft = ffi_type_struct(rtype); @@ -4953,10 +4960,11 @@ static void ffi_closure_dispatch_safe(ffi_cif *cif, void *cret, val ffi_make_closure(val fun, val call_desc, val safe_p_in, val abort_ret_in) { - val self = lit("ffi-make-closure"); + val real_self = lit("ffi-make-closure"); struct txr_ffi_closure *tfcl = coerce(struct txr_ffi_closure *, chk_calloc(1, sizeof *tfcl)); - struct txr_ffi_call_desc *tfcd = ffi_call_desc_checked(self, call_desc); + struct txr_ffi_call_desc *tfcd = ffi_call_desc_checked(real_self, call_desc); + val self = if3(tfcd->name, tfcd->name, real_self); val obj = cobj(coerce(mem_t *, tfcl), ffi_closure_s, &ffi_closure_ops); val safe_p = default_arg_strict(safe_p_in, t); ffi_status ffis = FFI_OK; @@ -6328,7 +6336,7 @@ void ffi_init(void) reg_fun(intern(lit("ffi-type-operator-p"), user_package), func_n1(ffi_type_operator_p)); reg_fun(intern(lit("ffi-type-p"), user_package), func_n1(ffi_type_p)); #if HAVE_LIBFFI - reg_fun(intern(lit("ffi-make-call-desc"), user_package), func_n4(ffi_make_call_desc)); + reg_fun(intern(lit("ffi-make-call-desc"), user_package), func_n5o(ffi_make_call_desc, 4)); reg_fun(intern(lit("ffi-call"), user_package), func_n2v(ffi_call_wrap)); reg_fun(intern(lit("ffi-make-closure"), user_package), func_n4o(ffi_make_closure, 2)); #endif @@ -74,7 +74,8 @@ extern val ffi_type_s, ffi_call_desc_s, ffi_closure_s; val ffi_type_compile(val syntax); val ffi_type_operator_p(val sym); val ffi_type_p(val sym); -val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes); +val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes, + val name); val ffi_make_closure(val fun, val call_desc, val safe_p_in, val abort_ret_in); mem_t *ffi_closure_get_fptr(val self, val closure); val ffi_call_wrap(val fptr, val ffi_call_desc, struct args *args); diff --git a/share/txr/stdlib/ffi.tl b/share/txr/stdlib/ffi.tl index 480faf5d..58729ceb 100644 --- a/share/txr/stdlib/ffi.tl +++ b/share/txr/stdlib/ffi.tl @@ -81,7 +81,8 @@ (defvarl ,arg-types-sym [mapcar ffi-type-compile ',argtypes]) (defvarl ,call-desc-sym (ffi-make-call-desc ,nargs ,nvariadic ,ret-type-sym - ,arg-types-sym)) + ,arg-types-sym + ',name)) (defvarl ,fun-sym ,fun-ref) (defun ,name ,arg-syms (ffi-call ,fun-sym ,call-desc-sym ,*arg-syms))))))) @@ -103,7 +104,8 @@ (defvarl ,arg-types-sym [mapcar ffi-type-compile ',argtypes]) (defvarl ,call-desc-sym (ffi-make-call-desc ,nargs ,nvariadic ,ret-type-sym - ,arg-types-sym)) + ,arg-types-sym + ',name)) (defun ,name (,fun-sym) [ffi-make-closure ,fun-sym ,call-desc-sym ,safe-p ,abort-retval]))))) @@ -74953,7 +74953,8 @@ a Lisp expression denoting FFI syntax. .coNP Function @ ffi-make-call-desc .synb -.mets (ffi-make-call-desc < ntotal < nfixed < rettype << argtypes ) +.mets (ffi-make-call-desc < ntotal < nfixed < rettype +.mets \ \ < argtypes <> [ name ]) .syne .desc The @@ -74992,6 +74993,14 @@ If the function is variadic, then the first elements of this list specify the types of the fixed arguments; the remaining elements specify the variadic arguments. +The +.meta name +argument gives the name of the function for which this description is intended, +or some other identifying symbol. This symbols is used in diagnostic messages +related to errors in the construction of the descriptor itself or its +subsequent use. If this parameter is omitted, then the involved FFI functions +use their own names in reporting diagnostics. + Note: variadic functions must not be called using a non-variadic descriptor, and .IR "vice versa" , |