new vocab alien.handles: generate integer handles to allow references to Factor objects to be passed through the FFI

extra/alien/handles/authors.txt

@@ -0,0 +1 @@
+Joe Groff

extra/alien/handles/handles-tests.factor

@@ -0,0 +1,45 @@
+! (c)2010 Joe Groff bsd license
+USING: accessors alien alien.c-types alien.handles alien.syntax
+destructors kernel math tools.test ;
+IN: alien.handles.tests
+
+TUPLE: thingy { x integer } ;
+C: <thingy> thingy
+
+CALLBACK: int thingy-callback ( uint thingy-handle ) ;
+CALLBACK: int thingy-ptr-callback ( void* thingy-handle ) ;
+
+: test-thingy-callback ( -- alien )
+    [ alien-handle> x>> 1 + ] thingy-callback ;
+
+: test-thingy-ptr-callback ( -- alien )
+    [ alien-handle-ptr> x>> 1 + ] thingy-ptr-callback ;
+
+: invoke-test-thingy-callback ( thingy -- n )
+    test-thingy-callback int { uint } cdecl alien-indirect ;
+: invoke-test-thingy-ptr-callback ( thingy -- n )
+    test-thingy-ptr-callback int { void* } cdecl alien-indirect ;
+
+[ t f ] [
+    [ 5 <thingy> <alien-handle> &release-alien-handle [ alien-handle? ] keep ] with-destructors
+    alien-handle?
+] unit-test
+
+[ t f ] [
+    [ 5 <thingy> <alien-handle-ptr> &release-alien-handle-ptr [ alien-handle-ptr? ] keep ] with-destructors
+    alien-handle-ptr?
+] unit-test
+
+[ 6 ] [
+    [
+        5 <thingy> <alien-handle> &release-alien-handle
+        invoke-test-thingy-callback
+    ] with-destructors
+] unit-test
+
+[ 6 ] [
+    [
+        5 <thingy> <alien-handle-ptr> &release-alien-handle-ptr
+        invoke-test-thingy-ptr-callback
+    ] with-destructors
+] unit-test

extra/alien/handles/handles.factor

@@ -0,0 +1,49 @@
+! (c)2010 Joe Groff bsd license
+USING: alien alien.destructors assocs kernel math math.bitwise
+namespaces ;
+IN: alien.handles
+
+<PRIVATE
+
+SYMBOLS: alien-handle-counter alien-handles ;
+
+alien-handle-counter [ 0 ] initialize
+alien-handles [ H{ } clone ] initialize
+
+: biggest-handle ( -- n )
+    -1 32 bits ; inline
+
+: (next-handle) ( -- n )
+    alien-handle-counter [ 1 + biggest-handle bitand dup ] change-global ; inline
+
+: next-handle ( -- n )
+    [ (next-handle) dup alien-handles get-global key? ] [ drop ] while ;
+
+PRIVATE>
+
+: <alien-handle> ( object -- int )
+    next-handle [ alien-handles get-global set-at ] keep ; inline
+: alien-handle> ( int -- object )
+    alien-handles get-global at ; inline
+
+: alien-handle? ( int -- ? )
+    alien-handles get-global key? >boolean ; inline
+
+: release-alien-handle ( int -- )
+    alien-handles get-global delete-at ; inline
+
+DESTRUCTOR: release-alien-handle
+
+: <alien-handle-ptr> ( object -- void* )
+    <alien-handle> <alien> ; inline
+: alien-handle-ptr> ( void* -- object )
+    alien-address alien-handle> ; inline
+
+: alien-handle-ptr? ( alien -- ? )
+    alien-address alien-handle? ; inline
+
+: release-alien-handle-ptr ( alien -- )
+    alien-address release-alien-handle ; inline
+
+DESTRUCTOR: release-alien-handle-ptr
+

extra/alien/handles/summary.txt

@@ -0,0 +1 @@
+Generate integer handle values to allow Factor object references to be passed through the FFI