diff options
| -rw-r--r-- | ffi.c | 15 | ||||
| -rw-r--r-- | ffi.h | 2 | ||||
| -rw-r--r-- | share/txr/stdlib/ffi.tl | 10 | ||||
| -rw-r--r-- | txr.1 | 32 |
4 files changed, 44 insertions, 15 deletions
@@ -186,6 +186,7 @@ struct txr_ffi_closure { cnum nparam; val fun; val call_desc; + val abort_retval; struct txr_ffi_call_desc *tfcd; }; @@ -224,6 +225,7 @@ static void ffi_closure_mark_op(val obj) struct txr_ffi_closure *tfcl = ffi_closure_struct(obj); gc_mark(tfcl->fun); gc_mark(tfcl->call_desc); + gc_mark(tfcl->abort_retval); } static struct cobj_ops ffi_closure_ops = @@ -2048,8 +2050,12 @@ static void ffi_closure_dispatch_safe(ffi_cif *cif, void *cret, uw_unwind { s_exit_point = uw_curr_exit_point; - if (s_exit_point && rtft != 0) - memset(cret, 0, rtft->size); + if (s_exit_point && rtft != 0) { + if (!tfcl->abort_retval) + memset(cret, 0, rtft->size); + else + rtft->put(rtft, tfcl->abort_retval, cret, self); + } uw_curr_exit_point = 0; /* stops unwinding */ } @@ -2059,7 +2065,7 @@ 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 ffi_make_closure(val fun, val call_desc, val safe_p_in, val abort_ret_in) { val self = lit("ffi-make-closure"); struct txr_ffi_closure *tfcl = coerce(struct txr_ffi_closure *, @@ -2090,6 +2096,7 @@ val ffi_make_closure(val fun, val call_desc, val safe_p_in) tfcl->fun = fun; tfcl->call_desc = call_desc; tfcl->tfcd = tfcd; + tfcl->abort_retval = default_null_arg(abort_ret_in); return obj; } @@ -2220,7 +2227,7 @@ void ffi_init(void) reg_fun(intern(lit("ffi-type-compile"), user_package), func_n1(ffi_type_compile)); reg_fun(intern(lit("ffi-make-call-desc"), user_package), func_n4(ffi_make_call_desc)); reg_fun(intern(lit("ffi-call"), user_package), func_n3(ffi_call_wrap)); - reg_fun(intern(lit("ffi-make-closure"), user_package), func_n3o(ffi_make_closure, 2)); + reg_fun(intern(lit("ffi-make-closure"), user_package), func_n4o(ffi_make_closure, 2)); reg_fun(intern(lit("ffi-typedef"), user_package), func_n2(ffi_typedef)); reg_fun(intern(lit("ffi-size"), user_package), func_n1(ffi_size)); reg_fun(intern(lit("ffi-put-into"), user_package), func_n3(ffi_put_into)); @@ -53,7 +53,7 @@ extern val ffi_type_s, ffi_call_desc_s, ffi_closure_s; val ffi_type_compile(val syntax); val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes); -val ffi_make_closure(val fun, val call_desc, val safe_p_in); +val ffi_make_closure(val fun, val call_desc, val safe_p_in, val abort_ret_in); mem_t *ffi_closure_get_fptr(val closure); val ffi_call_wrap(val ffi_call_desc, val fptr, val args); val ffi_typedef(val name, val type); diff --git a/share/txr/stdlib/ffi.tl b/share/txr/stdlib/ffi.tl index 739023fd..ec164b61 100644 --- a/share/txr/stdlib/ffi.tl +++ b/share/txr/stdlib/ffi.tl @@ -72,7 +72,7 @@ (defmacro deffi-type (name type-expr) ^(ffi-typedef ',name (ffi-type-compile ',type-expr))) -(defun sys:deffi-cb-expander (f name rettype argtypes safe-p) +(defun sys:deffi-cb-expander (f name rettype argtypes safe-p abort-retval) (let ((ret-type-sym (gensym "ret-type-")) (arg-types-sym (gensym "arg-types-")) (call-desc-sym (gensym "call-desc-")) @@ -85,13 +85,13 @@ ,ret-type-sym ,arg-types-sym)) (defun ,name (,fun-sym) - [ffi-make-closure ,fun-sym ,call-desc-sym ,safe-p]))))) + [ffi-make-closure ,fun-sym ,call-desc-sym ,safe-p ,abort-retval]))))) -(defmacro deffi-cb (:form f name rettype argtypes) - (sys:deffi-cb-expander f name rettype argtypes t)) +(defmacro deffi-cb (:form f name rettype argtypes : abort-retval) + (sys:deffi-cb-expander f name rettype argtypes t abort-retval)) (defmacro deffi-cb-unsafe (:form f name rettype argtypes) - (sys:deffi-cb-expander f name rettype argtypes nil)) + (sys:deffi-cb-expander f name rettype argtypes nil nil)) (defmacro sizeof (type) (ffi-size (ffi-type-compile type))) @@ -54048,7 +54048,8 @@ argument types match. .coNP Function @ ffi-make-closure .synb -.mets (ffi-make-closure < lisp-fun < call-desc <> [ safe-p ]) +.mets (ffi-make-closure < lisp-fun < call-desc +.mets \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ >> [ safe-p <> [ abort-val ]]) .syne .desc The @@ -54094,7 +54095,12 @@ the control transfer when the foreign code itself finishes and returns. If the callback returns a value (its return type is other than .codn void ) then in this situation, the callback returns an all-zero-bits return -value to the foreign caller. +value to the foreign caller. If the +.meta abort-val +parameter is specified and its value is other than +.codn nil , +then that value will be used as the return value instead of an all-zero +bit pattern. An unsafely dispatched closure permits the capture of continuations from the callback across the foreign code and direct dynamic control transfers which @@ -54388,7 +54394,7 @@ as its value. .coNP Macros @ deffi-cb and @ deffi-cb-unsafe .synb -.mets (deffi-cb < name < rettype << argtypes ) +.mets (deffi-cb < name < rettype < argtypes <> [ abort-val ]) .mets (deffi-cb-unsafe < name < rettype << argtypes ) .syne .desc @@ -54425,18 +54431,34 @@ The generated function called then serves as a combinator which takes a Lisp function as its argument, and binds it to the FFI call descriptor to produce a FFI closure. That closure may then be passed to foreign functions as a callback. +The +.code deffi-cb +macro generates a callback which uses safe dispatch, which is explained +in the description of the +.code ffi-make-callback +function. The optional +.meta abort-val +parameter specifies an expression which evaluates to the value +to be returned by the callback in the event that a dynamic control +transfer is intercepted. The purpose of this value is to indicate +to the foreign code that the callback wishes to abort operation; +it is useful in situations when a suitable return value will induce +the foreign code to co-operate and itself return to the Lisp code +which will then continue the dynamic control transfer. The .code deffi-cb-unsafe macro is a variant of .code deffi-cb -with exactly the same conventions. The difference is that it arranges for +with the same argument conventions. The difference is that it arranges for .code ffi-make-closure to be invoked with .code nil for the .meta safe-p -parameter. +parameter. This macro has no +.meta abort-val +parameter, since unsafe callbacks do not use it. .TP* Example: |