From 5ccce283fa384a04d332cfaaed3fbf9a7724c4d6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 21 Nov 2009 17:24:37 -0600 Subject: [PATCH] Various Windows load fixes --- basis/io/backend/windows/nt/nt.factor | 8 +- basis/io/files/info/windows/windows.factor | 9 +- basis/io/files/windows/windows.factor | 8 +- basis/io/sockets/windows/nt/nt.factor | 3 +- basis/random/windows/windows.factor | 2 +- basis/windows/com/com-tests.factor | 130 +++++++++++---------- basis/windows/time/time.factor | 4 +- 7 files changed, 84 insertions(+), 80 deletions(-) mode change 100644 => 100755 basis/random/windows/windows.factor mode change 100644 => 100755 basis/windows/com/com-tests.factor mode change 100644 => 100755 basis/windows/time/time.factor diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor index 1301d69913..de29f33ee6 100755 --- a/basis/io/backend/windows/nt/nt.factor +++ b/basis/io/backend/windows/nt/nt.factor @@ -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 :> bytes f :> key f :> 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 ( -- ) diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index d317a717bd..cc6218a4ea 100755 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -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 diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 3a088a1730..c4c848cb64 100755 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -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 ) diff --git a/basis/io/sockets/windows/nt/nt.factor b/basis/io/sockets/windows/nt/nt.factor index 937dae347a..0dd85954ac 100755 --- a/basis/io/sockets/windows/nt/nt.factor +++ b/basis/io/sockets/windows/nt/nt.factor @@ -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 ) diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor old mode 100644 new mode 100755 index 757540c4c6..c1d3010c0f --- a/basis/random/windows/windows.factor +++ b/basis/random/windows/windows.factor @@ -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 ; diff --git a/basis/windows/com/com-tests.factor b/basis/windows/com/com-tests.factor old mode 100644 new mode 100755 index 25e30829c0..329a84ef13 --- a/basis/windows/com/com-tests.factor +++ b/basis/windows/com/com-tests.factor @@ -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 - -{ - { 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 - } } -} -dup +test-wrapper+ set [ - - 0 swap com-wrap - dup +guinea-pig-implementation+ set [ drop - - S_OK 1array [ +guinea-pig-implementation+ get ISimple::returnOK ] unit-test - E_FAIL *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 - +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 + +[ + { + { 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 + } } + } + dup +test-wrapper+ set [ + + 0 swap com-wrap + dup +guinea-pig-implementation+ set [ drop + + S_OK 1array [ +guinea-pig-implementation+ get ISimple::returnOK ] unit-test + E_FAIL *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 + +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 diff --git a/basis/windows/time/time.factor b/basis/windows/time/time.factor old mode 100644 new mode 100755 index 1fe3ad065c..dfe12aaf3c --- a/basis/windows/time/time.factor +++ b/basis/windows/time/time.factor @@ -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 ) -- 2.34.1