From cc34ead7541b3d567ee62380c324bbf0f4f37c8a Mon Sep 17 00:00:00 2001
From: "U-SLAVA-DFB8FF805\\Slava" <Slava@slava-dfb8ff805.(none)>
Date: Wed, 3 Dec 2008 09:12:57 -0600
Subject: [PATCH] Update windows.com.wrapper for specialized-arrays changes

---
 basis/windows/com/wrapper/wrapper.factor | 33 +++++++++++++-----------
 1 file changed, 18 insertions(+), 15 deletions(-)
 mode change 100644 => 100755 basis/windows/com/wrapper/wrapper.factor

diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor
old mode 100644
new mode 100755
index 5cb830bc66..710feeec4d
--- a/basis/windows/com/wrapper/wrapper.factor
+++ b/basis/windows/com/wrapper/wrapper.factor
@@ -1,8 +1,9 @@
-USING: alien alien.c-types windows.com.syntax init
-windows.com.syntax.private windows.com continuations kernel
+USING: alien alien.c-types alien.accessors windows.com.syntax
+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 ;
+destructors fry math.parser generalizations sets
+specialized-arrays.alien specialized-arrays.direct.alien ;
 IN: windows.com.wrapper
 
 TUPLE: com-wrapper callbacks vtbls disposed ;
@@ -51,23 +52,26 @@ unless
         _ case
         [
             "void*" heap-size * rot <displaced-alien> com-add-ref
-            0 rot set-void*-nth S_OK
-        ] [ nip f 0 rot set-void*-nth E_NOINTERFACE ] if*
+            swap 0 set-alien-cell S_OK
+        ] [ nip f swap 0 set-alien-cell E_NOINTERFACE ] if*
     ] ;
 
 : (make-add-ref) ( interfaces -- quot )
     length "void*" heap-size * '[
-        _ swap <displaced-alien>
-        0 over ulong-nth
-        1+ [ 0 rot set-ulong-nth ] keep
+        _
+        [ alien-unsigned-4 1+ dup ]
+        [ set-alien-unsigned-4 ]
+        2bi
     ] ;
 
 : (make-release) ( interfaces -- quot )
     length "void*" heap-size * '[
-        _ over <displaced-alien>
-        0 over ulong-nth
-        1- [ 0 rot set-ulong-nth ] keep
-        dup zero? [ swap (free-wrapped-object) ] [ nip ] if
+        _
+        [ drop ]
+        [ alien-unsigned-4 1- dup ]
+        [ set-alien-unsigned-4 ]
+        2tri
+        dup 0 = [ swap (free-wrapped-object) ] [ nip ] if
     ] ;
 
 : (make-iunknown-methods) ( interfaces -- quots )
@@ -125,8 +129,7 @@ unless
 : (malloc-wrapped-object) ( wrapper -- wrapped-object )
     vtbls>> length "void*" heap-size *
     [ "ulong" heap-size + malloc ] keep
-    over <displaced-alien>
-    1 0 rot set-ulong-nth ;
+    [ [ 1 ] 2dip set-alien-unsigned-4 ] [ drop ] 2bi ;
 
 : (callbacks>vtbl) ( callbacks -- vtbl )
     [ execute ] void*-array{ } map-as underlying>> malloc-byte-array ;
@@ -159,5 +162,5 @@ M: com-wrapper dispose*
 
 : com-wrap ( object wrapper -- wrapped-object )
     [ vtbls>> ] [ (malloc-wrapped-object) ] bi
-    [ [ set-void*-nth ] curry each-index ] keep
+    [ over length <direct-void*-array> 0 swap copy ] keep
     [ +wrapped-objects+ get-global set-at ] keep ;