Merge branch 'master' of git://factorcode.org/git/factor

basis/io/windows/nt/privileges/privileges.factor

@@ -42,7 +42,6 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
     [ lookup-privilege ] dip
     [
         TOKEN_PRIVILEGES-Privileges
-        [ 0 ] dip LUID_AND_ATTRIBUTES-nth
         set-LUID_AND_ATTRIBUTES-Luid
     ] keep ;
 

basis/windows/com/wrapper/wrapper.factor

@@ -1,8 +1,9 @@
-USING: alien alien.c-types windows.com.syntax init
+USING: alien alien.c-types alien.accessors windows.com.syntax
-windows.com.syntax.private windows.com continuations kernel
+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
+            swap 0 set-alien-cell S_OK
-        ] [ nip f 0 rot set-void*-nth E_NOINTERFACE ] if*
+        ] [ 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
+        [ alien-unsigned-4 1+ dup ]
-        1+ [ 0 rot set-ulong-nth ] keep
+        [ set-alien-unsigned-4 ]
+        2bi
     ] ;
 
 : (make-release) ( interfaces -- quot )
     length "void*" heap-size * '[
-        _ over <displaced-alien>
+        _
-        0 over ulong-nth
+        [ drop ]
-        1- [ 0 rot set-ulong-nth ] keep
+        [ alien-unsigned-4 1- dup ]
-        dup zero? [ swap (free-wrapped-object) ] [ nip ] if
+        [ 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 ] 2dip set-alien-unsigned-4 ] [ drop ] 2bi ;
-    1 0 rot set-ulong-nth ;
 
 : (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 ;

extra/cfdg/cfdg.factor

@@ -6,8 +6,10 @@ USING: kernel alien.c-types combinators namespaces make arrays
        vars colors self self.slots
        random-weighted colors.hsv cfdg.gl accessors
        ui.gadgets.handler ui.gestures assocs ui.gadgets macros
-       qualified speicalized-arrays.double ;
+       qualified specialized-arrays.double ;
+
 QUALIFIED: syntax
+
 IN: cfdg
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -53,7 +55,10 @@ VAR: color-stack
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: double-nth* ( c-array indices -- seq ) swap [ double-nth ] curry map ;
+! : double-nth* ( c-array indices -- seq ) swap [ double-nth ] curry map ;
+
+: double-nth* ( c-array indices -- seq )
+  swap byte-array>double-array [ nth ] curry map ;
 
 : check-size ( modelview -- num ) { 0 1 4 5 } double-nth* [ abs ] map biggest ;