ffi: a measure of safety for callbacks.

We don't want, by default, for callbacks to capture delimited
continuations across foreign code, or perpetrate non-local
transfers across foreign code. Here, we take an approach
similar for what was done in ftw_wrap.

* ffi.c (s_exit_point): New global variable with internal
linkage.
(ffi_call_wrap): If s_exit_point isn't nil, then it means that
the callback intercepted a nonlocal transfer and stored its
exit point. We resume the transfer to that exit point instead
of returning normally.
(ffi_closure_dispatch_safe): New static function.
(ffi_make_closure): Support a new argument which indicates
whether to make a closure which uses
ffi_closure_dispatch_safe, or ffi_closure_dispatch.
(ffi_init): Update registration of ffi-make-closure intrinsic.

* ffi.h (ffi_make_closure): Declaration updated.

* share/txr/stdlib/ffi.tl (sys:deffi-cb-expander): New
function.
(deffi-cb): Macro internals replaced by call to new
function.
(deffi-cb-safe): New macro.

* txr.1: Documentation of ffi-make-closure updated.
New deffi-cb-unsafe macro documented.

1 files changed, 16 insertions, 10 deletions

diff --git a/share/txr/stdlib/ffi.tl b/share/txr/stdlib/ffi.tl
index 2d61e640..739023fd 100644
--- a/share/txr/stdlib/ffi.tl
+++ b/share/txr/stdlib/ffi.tl
@@ -72,20 +72,26 @@
 (defmacro deffi-type (name type-expr)
   ^(ffi-typedef ',name (ffi-type-compile ',type-expr)))
 
-(defmacro deffi-cb (:form f name rettype argtypes)
+(defun sys:deffi-cb-expander (f name rettype argtypes safe-p)
   (let ((ret-type-sym (gensym "ret-type-"))
         (arg-types-sym (gensym "arg-types-"))
         (call-desc-sym (gensym "call-desc-"))
         (fun-sym (gensym "fun-")))
-  (tree-bind (nargs nvariadic . argtypes) (sys:analyze-argtypes f argtypes)
-    ^(progn
-       (defvarl ,ret-type-sym (ffi-type-compile ',rettype))
-       (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))
-       (defun ,name (,fun-sym)
-         [ffi-make-closure ,fun-sym ,call-desc-sym])))))
+    (tree-bind (nargs nvariadic . argtypes) (sys:analyze-argtypes f argtypes)
+      ^(progn
+         (defvarl ,ret-type-sym (ffi-type-compile ',rettype))
+         (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))
+         (defun ,name (,fun-sym)
+           [ffi-make-closure ,fun-sym ,call-desc-sym ,safe-p])))))
+
+(defmacro deffi-cb (:form f name rettype argtypes)
+  (sys:deffi-cb-expander f name rettype argtypes t))
+
+(defmacro deffi-cb-unsafe (:form f name rettype argtypes)
+  (sys:deffi-cb-expander f name rettype argtypes nil))
 
 (defmacro sizeof (type)
   (ffi-size (ffi-type-compile type)))