alien,stack-checker.alien: new word with-callback

Since callbacks aren't automatically deallocated this word intends to
make sure "inline" callbacks are.

diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor
index ee62c10e50e7f80d9f04e6b9440f31f504ee155c..fdaa5add17b58705bbbd8d69d95b0400d060e1b4 100644 (file)
--- a/basis/stack-checker/alien/alien.factor
+++ b/basis/stack-checker/alien/alien.factor
@@ -105,10 +105,7 @@ TUPLE: alien-callback-params < alien-node-params xt ;
     infer-return ;
 
 : callback-xt ( word -- alien )
-    callbacks get [
-        dup "stack-cleanup" word-prop <callback>
-        [ callback-destructor new-disposable callback<< ] keep
-    ] cache ;
+    callbacks get [ dup "stack-cleanup" word-prop <callback> ] cache ;
 
 : callback-bottom ( params -- )
     "( callback )" <uninterned-word> >>xt

diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor
index b4c61e6ce33200c7f8d5e199f59907623648987d..29a3d0e35f0f2e1d0be458620c9b0345488d96c5 100644 (file)
--- a/core/alien/alien-docs.factor
+++ b/core/alien/alien-docs.factor
@@ -65,7 +65,11 @@ HELP: free-callback
 { $description "Releases the callback heap memory allocated for an alien callback. " }
 { $warning "If the callback is invoked (either from C or Factor) after it has been freed, then Factor may crash." } ;
 
-{ <callback> free-callback } related-words
+HELP: with-callback
+{ $values { "alien" alien } { "quot" quotation } }
+{ $description "Calls the quotation with an alien value on the stack which is supposed to be a callback. Resources for the callback is guaranteed to be released afterwards." } ;
+
+{ <callback> free-callback unregister-and-free-callback with-callback } related-words
 
 HELP: alien-address
 { $values { "c-ptr" c-ptr } { "addr" "a non-negative integer" } }

diff --git a/core/alien/alien.factor b/core/alien/alien.factor
index 12466ef5c1f703fb404e638fc91030869b9e6a63..20fb758efd1d4acf931341cbbd7b5a572e55340b 100755 (executable)
--- a/core/alien/alien.factor
+++ b/core/alien/alien.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs byte-arrays byte-vectors continuations.private
-destructors init kernel kernel.private math namespaces sequences ;
+USING: accessors assocs byte-arrays byte-vectors continuations
+continuations.private destructors init kernel kernel.private math namespaces
+sequences ;
 IN: alien
 
 BUILTIN: alien { underlying c-ptr read-only initial: f } expired ;
@@ -111,15 +112,6 @@ SYMBOL: callbacks
     current-callback
     [ 2drop call ] [ swap call( callback -- ) drop ] 3bi ; inline
 
-! Used by stack-checker.alien to register destructors for callbacks.
-TUPLE: callback-destructor callback ;
-
-: delete-values ( value assoc -- )
-    [ rot drop = not ] with assoc-filter! drop ;
-
-M: callback-destructor dispose ( disposable -- )
-    callback>> [ callbacks get delete-values ] [ free-callback ] bi ;
-
 ! A utility for defining global variables that are recompiled in
 ! every session
 TUPLE: expiry-check object alien ;
@@ -127,8 +119,17 @@ TUPLE: expiry-check object alien ;
 : recompute-value? ( check -- ? )
     dup [ alien>> expired? ] [ drop t ] if ;
 
+: delete-values ( value assoc -- )
+    [ rot drop = not ] with assoc-filter! drop ;
+
 PRIVATE>
 
+: unregister-and-free-callback ( alien -- )
+    [ callbacks get delete-values ] [ free-callback ] bi ;
+
+: with-callback ( alien quot -- )
+    over [ unregister-and-free-callback ] curry [ ] cleanup ; inline
+
 : initialize-alien ( symbol quot -- )
     swap dup get-global dup recompute-value?
     [ drop [ call dup 31337 <alien> expiry-check boa ] dip set-global ]