steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Various Windows load fixes

db4
Slava Pestov 2009-11-21 17:24:37 -06:00
parent 50b3f076e8
commit 5ccce283fa
7 changed files with 76 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/io/backend/windows/nt/nt.factor
View File

@ -50,12 +50,12 @@ M: winnt add-completion ( win32-handle -- )
} cond } cond
] with-timeout ; ] with-timeout ;
:: wait-for-overlapped ( usec -- bytes-transferred overlapped error? ) :: wait-for-overlapped ( nanos -- bytes-transferred overlapped error? )
master-completion-port get-global master-completion-port get-global
0 <int> :> bytes 0 <int> :> bytes
f <void*> :> key f <void*> :> key
f <void*> :> overlapped 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 key overlapped timeout GetQueuedCompletionStatus zero? :> error?
bytes *int bytes *int
@ -65,7 +65,7 @@ M: winnt add-completion ( win32-handle -- )
: resume-callback ( result overlapped -- ) : resume-callback ( result overlapped -- )
>c-ptr pending-overlapped get-global delete-at* drop resume-with ; >c-ptr pending-overlapped get-global delete-at* drop resume-with ;
: handle-overlapped ( us -- ? ) : handle-overlapped ( nanos -- ? )
wait-for-overlapped [ wait-for-overlapped [
[ [
[ drop GetLastError 1array ] dip resume-callback t [ drop GetLastError 1array ] dip resume-callback t
@ -75,7 +75,7 @@ M: winnt add-completion ( win32-handle -- )
M: win32-handle cancel-operation M: win32-handle cancel-operation
[ check-disposed ] [ handle>> CancelIo drop ] bi ; [ check-disposed ] [ handle>> CancelIo drop ] bi ;
M: winnt io-multiplex ( us -- ) M: winnt io-multiplex ( nanos -- )
handle-overlapped [ 0 io-multiplex ] when ; handle-overlapped [ 0 io-multiplex ] when ;
M: winnt init-io ( -- ) M: winnt init-io ( -- )

9
basis/io/files/info/windows/windows.factor
View File

@ -2,10 +2,11 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: byte-arrays math io.backend io.files.info USING: byte-arrays math io.backend io.files.info
io.files.windows io.files.windows.nt kernel windows.kernel32 io.files.windows io.files.windows.nt kernel windows.kernel32
windows.time windows accessors alien.c-types combinators windows.time windows.types windows accessors alien.c-types
generalizations system alien.strings io.encodings.utf16n combinators generalizations system alien.strings
sequences splitting windows.errors fry continuations destructors io.encodings.utf16n sequences splitting windows.errors fry
calendar ascii combinators.short-circuit locals classes.struct continuations destructors calendar ascii
combinators.short-circuit locals classes.struct
specialized-arrays alien.data ; specialized-arrays alien.data ;
SPECIALIZED-ARRAY: ushort SPECIALIZED-ARRAY: ushort
IN: io.files.info.windows IN: io.files.info.windows

8
basis/io/files/windows/windows.factor
View File

@ -3,10 +3,10 @@
USING: alien.c-types io.binary io.backend io.files USING: alien.c-types io.binary io.backend io.files
io.files.types io.buffers io.encodings.utf16n io.ports io.files.types io.buffers io.encodings.utf16n io.ports
io.backend.windows kernel math splitting fry alien.strings io.backend.windows kernel math splitting fry alien.strings
windows windows.kernel32 windows.time calendar combinators windows windows.kernel32 windows.time windows.types calendar
math.functions sequences namespaces make words system combinators math.functions sequences namespaces make words
destructors accessors math.bitwise continuations windows.errors system destructors accessors math.bitwise continuations
arrays byte-arrays generalizations alien.data ; windows.errors arrays byte-arrays generalizations alien.data ;
IN: io.files.windows IN: io.files.windows
: open-file ( path access-mode create-mode flags -- handle ) : open-file ( path access-mode create-mode flags -- handle )

3
basis/io/sockets/windows/nt/nt.factor
View File

@ -3,7 +3,8 @@ continuations destructors io.ports io.timeouts io.sockets
io.sockets.private io namespaces io.streams.duplex io.sockets.private io namespaces io.streams.duplex
io.backend.windows io.sockets.windows io.backend.windows.nt io.backend.windows io.sockets.windows io.backend.windows.nt
windows.winsock kernel libc math sequences threads system 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 IN: io.sockets.windows.nt
: malloc-int ( n -- alien ) : malloc-int ( n -- alien )

2
basis/random/windows/windows.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
USING: accessors alien.c-types alien.data byte-arrays USING: accessors alien.c-types alien.data byte-arrays
combinators.short-circuit continuations destructors init kernel combinators.short-circuit continuations destructors init kernel
locals namespaces random windows.advapi32 windows.errors locals namespaces random windows.advapi32 windows.errors
windows.kernel32 math.bitwise ; windows.kernel32 windows.types math.bitwise ;
IN: random.windows IN: random.windows
TUPLE: windows-rng provider type ; TUPLE: windows-rng provider type ;

114
basis/windows/com/com-tests.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
USING: kernel windows.com windows.com.syntax windows.ole32 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 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 IN: windows.com.tests
COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc} 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 +wrapped-objects+ get-global clone +orig-wrapped-objects+ set-global
TUPLE: test-implementation x ; TUPLE: test-implementation x ;
C: <test-implementation> test-implementation C: <test-implementation> test-implementation
{ [
{ IInherited { {
[ drop S_OK ] ! ISimple::returnOK { IInherited {
[ drop E_FAIL ] ! ISimple::returnError [ drop S_OK ] ! ISimple::returnOK
[ x>> ] ! IInherited::getX [ drop E_FAIL ] ! ISimple::returnError
[ >>x drop ] ! IInherited::setX [ x>> ] ! IInherited::getX
} } [ >>x drop ] ! IInherited::setX
{ IUnrelated { } }
[ [ x>> ] [ + ] bi* ] ! IUnrelated::xPlus { IUnrelated {
[ [ x>> ] [ * ] [ + ] tri* ] ! IUnrelated::xMulAdd [ [ x>> ] [ + ] bi* ] ! IUnrelated::xPlus
} } [ [ x>> ] [ * ] [ + ] tri* ] ! IUnrelated::xMulAdd
} <com-wrapper> } }
dup +test-wrapper+ set [ } <com-wrapper>
dup +test-wrapper+ set [
0 <test-implementation> swap com-wrap 0 <test-implementation> swap com-wrap
dup +guinea-pig-implementation+ set [ drop dup +guinea-pig-implementation+ set [ drop
S_OK 1array [ +guinea-pig-implementation+ get ISimple::returnOK ] unit-test S_OK 1array [ +guinea-pig-implementation+ get ISimple::returnOK ] unit-test
E_FAIL <long> *long 1array [ +guinea-pig-implementation+ get ISimple::returnError ] unit-test E_FAIL <long> *long 1array [ +guinea-pig-implementation+ get ISimple::returnError ] unit-test
20 1array [ 20 1array [
+guinea-pig-implementation+ get +guinea-pig-implementation+ get
[ 20 IInherited::setX ] [ 20 IInherited::setX ]
[ IInherited::getX ] bi [ IInherited::getX ] bi
] unit-test ] unit-test
420 1array [ 420 1array [
+guinea-pig-implementation+ get +guinea-pig-implementation+ get
IUnrelated-iid com-query-interface IUnrelated-iid com-query-interface
[ 20 20 IUnrelated::xMulAdd ] with-com-interface [ 20 20 IUnrelated::xMulAdd ] with-com-interface
] unit-test ] unit-test
40 1array [ 40 1array [
+guinea-pig-implementation+ get +guinea-pig-implementation+ get
IUnrelated-iid com-query-interface IUnrelated-iid com-query-interface
[ 20 IUnrelated::xPlus ] with-com-interface [ 20 IUnrelated::xPlus ] with-com-interface
] unit-test ] unit-test
+guinea-pig-implementation+ get 1array [ +guinea-pig-implementation+ get 1array [
+guinea-pig-implementation+ get com-add-ref +guinea-pig-implementation+ get com-add-ref
] unit-test ] unit-test
{ } [ +guinea-pig-implementation+ get com-release ] unit-test { } [ +guinea-pig-implementation+ get com-release ] unit-test
+guinea-pig-implementation+ get 1array [ +guinea-pig-implementation+ get 1array [
+guinea-pig-implementation+ get IUnknown-iid com-query-interface +guinea-pig-implementation+ get IUnknown-iid com-query-interface
dup com-release dup com-release
] unit-test ] unit-test
+guinea-pig-implementation+ get 1array [ +guinea-pig-implementation+ get 1array [
+guinea-pig-implementation+ get ISimple-iid com-query-interface +guinea-pig-implementation+ get ISimple-iid com-query-interface
dup com-release dup com-release
] unit-test ] unit-test
void* heap-size +guinea-pig-implementation+ get <displaced-alien> void* heap-size +guinea-pig-implementation+ get <displaced-alien>
+guinea-pig-implementation+ get +guinea-pig-implementation+ get
2array [ 2array [
+guinea-pig-implementation+ get IUnrelated-iid com-query-interface +guinea-pig-implementation+ get IUnrelated-iid com-query-interface
dup ISimple-iid com-query-interface dup ISimple-iid com-query-interface
over com-release dup com-release over com-release dup com-release
] unit-test ] unit-test
] with-com-interface ] with-com-interface
] with-disposal ] with-disposal
] with-compilation-unit
! Ensure that we freed +guinea-pig-implementation ! Ensure that we freed +guinea-pig-implementation
+orig-wrapped-objects+ get-global 1array [ +wrapped-objects+ get-global ] unit-test +orig-wrapped-objects+ get-global 1array [ +wrapped-objects+ get-global ] unit-test

4
basis/windows/time/time.factor Normal file → Executable file
View File

@ -1,8 +1,8 @@
! Copyright (C) 2007 Doug Coleman. ! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types kernel math windows.errors USING: alien alien.c-types kernel math windows.errors
windows.kernel32 namespaces calendar math.bitwise accessors windows.kernel32 windows.types namespaces calendar math.bitwise
classes.struct ; accessors classes.struct ;
IN: windows.time IN: windows.time
: >64bit ( lo hi -- n ) : >64bit ( lo hi -- n )