fix windows usings

[factor.git] / basis / windows / com / wrapper / wrapper.factor

diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor
index a014a56ea03219afd101af339f8b9536aa767bb5..2af416fb7e80fbc8d4a80584e482918f7617fac4 100755 (executable)
--- a/basis/windows/com/wrapper/wrapper.factor
+++ b/basis/windows/com/wrapper/wrapper.factor
@@ -3,10 +3,11 @@ init windows.com.syntax.private windows.com continuations kernel
 namespaces windows.ole32 libc vocabs assocs accessors arrays
 sequences quotations combinators math words compiler.units
 destructors fry math.parser generalizations sets
-specialized-arrays.alien specialized-arrays.direct.alien ;
+specialized-arrays.alien specialized-arrays.direct.alien
+windows.kernel32 ;
 IN: windows.com.wrapper
 
-TUPLE: com-wrapper callbacks vtbls disposed ;
+TUPLE: com-wrapper < disposable callbacks vtbls ;
 
 <PRIVATE
 
@@ -28,7 +29,7 @@ unless
 "windows.com.wrapper.callbacks" create-vocab drop
 
 : (next-vtbl-counter) ( -- n )
-    +vtbl-counter+ [ 1+ dup ] change ;
+    +vtbl-counter+ [ 1 + dup ] change ;
 
 : com-unwrap ( wrapped -- object )
     +wrapped-objects+ get-global at*
@@ -48,7 +49,7 @@ unless
 : (make-query-interface) ( interfaces -- quot )
     (query-interface-cases) 
     '[
-        swap 16 memory>byte-array
+        swap GUID memory>struct
         _ case
         [
             "void*" heap-size * rot <displaced-alien> com-add-ref
@@ -59,7 +60,7 @@ unless
 : (make-add-ref) ( interfaces -- quot )
     length "void*" heap-size * '[
         _
-        [ alien-unsigned-4 1+ dup ]
+        [ alien-unsigned-4 1 + dup ]
         [ set-alien-unsigned-4 ]
         2bi
     ] ;
@@ -68,7 +69,7 @@ unless
     length "void*" heap-size * '[
         _
         [ drop ]
-        [ alien-unsigned-4 1- dup ]
+        [ alien-unsigned-4 1 - dup ]
         [ set-alien-unsigned-4 ]
         2tri
         dup 0 = [ swap (free-wrapped-object) ] [ nip ] if
@@ -93,7 +94,7 @@ unless
 
 : compile-alien-callback ( word return parameters abi quot -- word )
     '[ _ _ _ _ alien-callback ]
-    [ [ (( -- alien )) define-declared ] pick slip ]
+    [ [ (( -- alien )) define-declared ] pick [ call ] dip ]
     with-compilation-unit ;
 
 : (callback-word) ( function-name interface-name counter -- word )
@@ -101,7 +102,7 @@ unless
     "windows.com.wrapper.callbacks" create ;
 
 : (finish-thunk) ( param-count thunk quot -- thunked-quot )
-    [ [ drop [ ] ] [ swap 1- '[ _ _ ndip ] ] if-empty ]
+    [ [ drop [ ] ] [ swap 1 - '[ _ _ ndip ] ] if-empty ]
     dip compose ;
 
 : (make-interface-callbacks) ( interface-name quots iunknown-methods n -- words )
@@ -132,7 +133,7 @@ unless
     [ [ 1 ] 2dip set-alien-unsigned-4 ] [ drop ] 2bi ;
 
 : (callbacks>vtbl) ( callbacks -- vtbl )
-    [ execute ] void*-array{ } map-as malloc-byte-array ;
+    [ execute( -- callback ) ] void*-array{ } map-as malloc-byte-array ;
 : (callbacks>vtbls) ( callbacks -- vtbls )
     [ (callbacks>vtbl) ] map ;
 
@@ -153,7 +154,7 @@ PRIVATE>
     [ +live-wrappers+ get adjoin ] bi ;
 
 : <com-wrapper> ( implementations -- wrapper )
-    (make-callbacks) f f com-wrapper boa
+    com-wrapper new-disposable swap (make-callbacks) >>callbacks
     dup allocate-wrapper ;
 
 M: com-wrapper dispose*