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
] 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 ( -- )

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

@ -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

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

@ -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 )

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.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 )

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
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 ;

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
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
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 [
[
{
{ 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
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
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 1array [
+guinea-pig-implementation+ get com-add-ref
] 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 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
+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-com-interface
] with-disposal
] with-disposal
] with-compilation-unit
! Ensure that we freed +guinea-pig-implementation
+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.
! 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 )