]> gitweb.factorcode.org Git - factor.git/commitdiff
Various Windows load fixes
authorSlava Pestov <slava@factorcode.org>
Sat, 21 Nov 2009 23:24:37 +0000 (17:24 -0600)
committerSlava Pestov <slava@factorcode.org>
Sat, 21 Nov 2009 23:24:37 +0000 (17:24 -0600)
basis/io/backend/windows/nt/nt.factor
basis/io/files/info/windows/windows.factor
basis/io/files/windows/windows.factor
basis/io/sockets/windows/nt/nt.factor
basis/random/windows/windows.factor [changed mode: 0644->0755]
basis/windows/com/com-tests.factor [changed mode: 0644->0755]
basis/windows/time/time.factor [changed mode: 0644->0755]

index 1301d699134b23147b09814d2eea4648f9d05b7b..de29f33ee612d20bfb84222e1fc07eba6f4ee7fe 100755 (executable)
@@ -50,12 +50,12 @@ M: winnt add-completion ( win32-handle -- )
         } cond
     ] with-timeout ;
 
-:: wait-for-overlapped ( usec -- bytes-transferred overlapped error? )
+:: wait-for-overlapped ( nanos -- bytes-transferred overlapped error? )
     master-completion-port get-global
     0 <int> :> bytes
     f <void*> :> key
     f <void*> :> overlapped
-    usec [ 1000 /i ] [ INFINITE ] if* :> timeout
+    nanos [ 1,000,000 /i ] [ INFINITE ] if* :> timeout
     bytes key overlapped timeout GetQueuedCompletionStatus zero? :> error?
 
     bytes *int
@@ -65,7 +65,7 @@ M: winnt add-completion ( win32-handle -- )
 : resume-callback ( result overlapped -- )
     >c-ptr pending-overlapped get-global delete-at* drop resume-with ;
 
-: handle-overlapped ( us -- ? )
+: handle-overlapped ( nanos -- ? )
     wait-for-overlapped [
         [
             [ drop GetLastError 1array ] dip resume-callback t
@@ -75,7 +75,7 @@ M: winnt add-completion ( win32-handle -- )
 M: win32-handle cancel-operation
     [ check-disposed ] [ handle>> CancelIo drop ] bi ;
 
-M: winnt io-multiplex ( us -- )
+M: winnt io-multiplex ( nanos -- )
     handle-overlapped [ 0 io-multiplex ] when ;
 
 M: winnt init-io ( -- )
index d317a717bdc641cfce6f7b601e69be4d135c05a7..cc6218a4ea6df3a8218a5542bf6f516187b849de 100755 (executable)
@@ -2,10 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: byte-arrays math io.backend io.files.info
 io.files.windows io.files.windows.nt kernel windows.kernel32
-windows.time windows accessors alien.c-types combinators
-generalizations system alien.strings io.encodings.utf16n
-sequences splitting windows.errors fry continuations destructors
-calendar ascii combinators.short-circuit locals classes.struct
+windows.time windows.types windows accessors alien.c-types
+combinators generalizations system alien.strings
+io.encodings.utf16n sequences splitting windows.errors fry
+continuations destructors calendar ascii
+combinators.short-circuit locals classes.struct
 specialized-arrays alien.data ;
 SPECIALIZED-ARRAY: ushort
 IN: io.files.info.windows
index 3a088a17302f510921bfc1a17e988e0997b20532..c4c848cb648ea92ff558d9ec97a6a16da0492c64 100755 (executable)
@@ -3,10 +3,10 @@
 USING: alien.c-types io.binary io.backend io.files
 io.files.types io.buffers io.encodings.utf16n io.ports
 io.backend.windows kernel math splitting fry alien.strings
-windows windows.kernel32 windows.time calendar combinators
-math.functions sequences namespaces make words system
-destructors accessors math.bitwise continuations windows.errors
-arrays byte-arrays generalizations alien.data ;
+windows windows.kernel32 windows.time windows.types calendar
+combinators math.functions sequences namespaces make words
+system destructors accessors math.bitwise continuations
+windows.errors arrays byte-arrays generalizations alien.data ;
 IN: io.files.windows
 
 : open-file ( path access-mode create-mode flags -- handle )
index 937dae347ac379f405d5ffbe7b150ed49fc1bb1f..0dd85954acb222857fc4b31f3e1e00e7a31b9469 100755 (executable)
@@ -3,7 +3,8 @@ continuations destructors io.ports io.timeouts io.sockets
 io.sockets.private io namespaces io.streams.duplex
 io.backend.windows io.sockets.windows io.backend.windows.nt
 windows.winsock kernel libc math sequences threads system
-combinators accessors classes.struct windows.kernel32 ;
+combinators accessors classes.struct windows.kernel32
+windows.types ;
 IN: io.sockets.windows.nt
 
 : malloc-int ( n -- alien )
old mode 100644 (file)
new mode 100755 (executable)
index 757540c..c1d3010
@@ -1,7 +1,7 @@
 USING: accessors alien.c-types alien.data byte-arrays
 combinators.short-circuit continuations destructors init kernel
 locals namespaces random windows.advapi32 windows.errors
-windows.kernel32 math.bitwise ;
+windows.kernel32 windows.types math.bitwise ;
 IN: random.windows
 
 TUPLE: windows-rng provider type ;
old mode 100644 (file)
new mode 100755 (executable)
index 25e3082..329a84e
@@ -1,7 +1,7 @@
 USING: kernel windows.com windows.com.syntax windows.ole32
-alien alien.syntax tools.test libc alien.c-types 
+alien alien.syntax tools.test libc alien.c-types
 namespaces arrays continuations accessors math windows.com.wrapper
-windows.com.wrapper.private destructors effects ;
+windows.com.wrapper.private destructors effects compiler.units ;
 IN: windows.com.tests
 
 COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc}
@@ -34,68 +34,70 @@ SYMBOL: +orig-wrapped-objects+
 +wrapped-objects+ get-global clone +orig-wrapped-objects+ set-global
 
 TUPLE: test-implementation x ;
-C: <test-implementation> test-implementation 
-
-{
-    { IInherited {
-        [ drop S_OK ] ! ISimple::returnOK
-        [ drop E_FAIL ] ! ISimple::returnError
-        [ x>> ] ! IInherited::getX
-        [ >>x drop ] ! IInherited::setX
-    } }
-    { IUnrelated {
-        [ [ x>> ] [ + ] bi* ] ! IUnrelated::xPlus
-        [ [ x>> ] [ * ] [ + ] tri* ] ! IUnrelated::xMulAdd
-    } }
-} <com-wrapper>
-dup +test-wrapper+ set [
-
-    0 <test-implementation> swap com-wrap
-    dup +guinea-pig-implementation+ set [ drop
-
-        S_OK 1array [ +guinea-pig-implementation+ get ISimple::returnOK ] unit-test
-        E_FAIL <long> *long 1array [ +guinea-pig-implementation+ get ISimple::returnError ] unit-test
-        20 1array [
-            +guinea-pig-implementation+ get
-            [ 20 IInherited::setX ]
-            [ IInherited::getX ] bi
-        ] unit-test
-        420 1array [
-            +guinea-pig-implementation+ get
-            IUnrelated-iid com-query-interface
-            [ 20 20 IUnrelated::xMulAdd ] with-com-interface
-        ] unit-test
-        40 1array [
-            +guinea-pig-implementation+ get
-            IUnrelated-iid com-query-interface
-            [ 20 IUnrelated::xPlus ] with-com-interface
-        ] unit-test
-
-        +guinea-pig-implementation+ get 1array [
-            +guinea-pig-implementation+ get com-add-ref
-        ] unit-test
-
-        { } [ +guinea-pig-implementation+ get com-release ] unit-test
-
-        +guinea-pig-implementation+ get 1array [
-            +guinea-pig-implementation+ get IUnknown-iid com-query-interface
-            dup com-release
-        ] unit-test
-        +guinea-pig-implementation+ get 1array [
-            +guinea-pig-implementation+ get ISimple-iid com-query-interface
-            dup com-release
-        ] unit-test
-        void* heap-size +guinea-pig-implementation+ get <displaced-alien>
-        +guinea-pig-implementation+ get
-        2array [
-            +guinea-pig-implementation+ get IUnrelated-iid com-query-interface
-            dup ISimple-iid com-query-interface
-            over com-release dup com-release
-        ] unit-test
-
-    ] with-com-interface
-
-] with-disposal
+C: <test-implementation> test-implementation
+
+[
+    {
+        { IInherited {
+            [ drop S_OK ] ! ISimple::returnOK
+            [ drop E_FAIL ] ! ISimple::returnError
+            [ x>> ] ! IInherited::getX
+            [ >>x drop ] ! IInherited::setX
+        } }
+        { IUnrelated {
+            [ [ x>> ] [ + ] bi* ] ! IUnrelated::xPlus
+            [ [ x>> ] [ * ] [ + ] tri* ] ! IUnrelated::xMulAdd
+        } }
+    } <com-wrapper>
+    dup +test-wrapper+ set [
+
+        0 <test-implementation> swap com-wrap
+        dup +guinea-pig-implementation+ set [ drop
+
+            S_OK 1array [ +guinea-pig-implementation+ get ISimple::returnOK ] unit-test
+            E_FAIL <long> *long 1array [ +guinea-pig-implementation+ get ISimple::returnError ] unit-test
+            20 1array [
+                +guinea-pig-implementation+ get
+                [ 20 IInherited::setX ]
+                [ IInherited::getX ] bi
+            ] unit-test
+            420 1array [
+                +guinea-pig-implementation+ get
+                IUnrelated-iid com-query-interface
+                [ 20 20 IUnrelated::xMulAdd ] with-com-interface
+            ] unit-test
+            40 1array [
+                +guinea-pig-implementation+ get
+                IUnrelated-iid com-query-interface
+                [ 20 IUnrelated::xPlus ] with-com-interface
+            ] unit-test
+
+            +guinea-pig-implementation+ get 1array [
+                +guinea-pig-implementation+ get com-add-ref
+            ] unit-test
+
+            { } [ +guinea-pig-implementation+ get com-release ] unit-test
+
+            +guinea-pig-implementation+ get 1array [
+                +guinea-pig-implementation+ get IUnknown-iid com-query-interface
+                dup com-release
+            ] unit-test
+            +guinea-pig-implementation+ get 1array [
+                +guinea-pig-implementation+ get ISimple-iid com-query-interface
+                dup com-release
+            ] unit-test                                              
+            void* heap-size +guinea-pig-implementation+ get <displaced-alien>
+            +guinea-pig-implementation+ get                                           
+            2array [
+                +guinea-pig-implementation+ get IUnrelated-iid com-query-interface
+                dup ISimple-iid com-query-interface
+                over com-release dup com-release
+            ] unit-test
+
+        ] with-com-interface
+
+    ] with-disposal
+] with-compilation-unit
 
 ! Ensure that we freed +guinea-pig-implementation
 +orig-wrapped-objects+ get-global 1array [ +wrapped-objects+ get-global ] unit-test
old mode 100644 (file)
new mode 100755 (executable)
index 1fe3ad0..dfe12aa
@@ -1,8 +1,8 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types kernel math windows.errors
-windows.kernel32 namespaces calendar math.bitwise accessors
-classes.struct ;
+windows.kernel32 windows.types namespaces calendar math.bitwise
+accessors classes.struct ;
 IN: windows.time
 
 : >64bit ( lo hi -- n )