--- /dev/null
+! (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
--- /dev/null
+! (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
+