Various Windows load fixes
parent
50b3f076e8
commit
5ccce283fa
|
@ -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 ( -- )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,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 )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
|
Loading…
Reference in New Issue