From 9a47e0004cc040c9e07f05ffb28f66562bbf289c Mon Sep 17 00:00:00 2001
From: Joe Groff <joe@victoria.(none)>
Date: Tue, 15 Jun 2010 15:31:19 -0700
Subject: [PATCH] new vocab alien.handles: generate integer handles to allow
 references to Factor objects to be passed through the FFI

---
 extra/alien/handles/authors.txt          |  1 +
 extra/alien/handles/handles-tests.factor | 45 ++++++++++++++++++++++
 extra/alien/handles/handles.factor       | 49 ++++++++++++++++++++++++
 extra/alien/handles/summary.txt          |  1 +
 4 files changed, 96 insertions(+)
 create mode 100644 extra/alien/handles/authors.txt
 create mode 100644 extra/alien/handles/handles-tests.factor
 create mode 100644 extra/alien/handles/handles.factor
 create mode 100644 extra/alien/handles/summary.txt

diff --git a/extra/alien/handles/authors.txt b/extra/alien/handles/authors.txt
new file mode 100644
index 0000000000..f13c9c1e77
--- /dev/null
+++ b/extra/alien/handles/authors.txt
@@ -0,0 +1 @@
+Joe Groff
diff --git a/extra/alien/handles/handles-tests.factor b/extra/alien/handles/handles-tests.factor
new file mode 100644
index 0000000000..38ce7c26c7
--- /dev/null
+++ b/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
diff --git a/extra/alien/handles/handles.factor b/extra/alien/handles/handles.factor
new file mode 100644
index 0000000000..e1b5a716d2
--- /dev/null
+++ b/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
+
diff --git a/extra/alien/handles/summary.txt b/extra/alien/handles/summary.txt
new file mode 100644
index 0000000000..17c2a240cd
--- /dev/null
+++ b/extra/alien/handles/summary.txt
@@ -0,0 +1 @@
+Generate integer handle values to allow Factor object references to be passed through the FFI