From f791c8c5d251fd69ca44d05d857e9e34cf09b9b9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Sep 2010 14:02:32 -0500 Subject: [PATCH] Squashed commit of the following: commit 197dbe9a6733775ac0ea19b3da4bd4dc3c85418c Author: Doug Coleman Date: Sat Sep 18 19:01:38 2010 -0500 Fix bootstrap, move privileges to windows.privileges commit 521c622f8afb15bf42d263c738cb990560dc29cb Author: Doug Coleman Date: Sat Sep 18 18:26:30 2010 -0500 Hopefully fix bootstrap commit eb3f22928b59758b9505430034044b5b94705da2 Author: Doug Coleman Date: Sat Sep 18 18:19:05 2010 -0500 Remove wince from factor codebase commit 619d6c99415f46208a7ede6a04b0ccda46b15360 Author: Doug Coleman Date: Sat Sep 18 16:07:46 2010 -0500 Remove Windows CE from vm/ --- GNUmakefile | 4 - Nmakefile | 11 +- basis/bootstrap/io/io.factor | 2 +- basis/bootstrap/stage2.factor | 3 +- basis/io/backend/windows/nt/nt.factor | 148 --------- .../privileges/privileges-tests.factor | 4 - .../windows/privileges/privileges.factor | 15 - basis/io/backend/windows/windows.factor | 32 +- basis/io/files/info/windows/windows.factor | 2 +- basis/io/files/unique/windows/windows.factor | 5 +- basis/io/files/windows/nt/authors.txt | 3 - basis/io/files/windows/nt/nt.factor | 65 ---- basis/io/files/windows/nt/platforms.txt | 1 - .../nt-tests.factor => windows-tests.factor} | 6 +- basis/io/files/windows/windows.factor | 306 +++++++++++++++--- basis/io/launcher/launcher.factor | 2 +- basis/io/launcher/windows/nt/authors.txt | 3 - basis/io/launcher/windows/nt/nt-tests.factor | 196 ----------- basis/io/launcher/windows/nt/nt.factor | 109 ------- basis/io/launcher/windows/nt/platforms.txt | 1 - .../windows/{nt => }/test/append.factor | 4 +- .../launcher/windows/{nt => }/test/env.factor | 0 .../launcher/windows/{nt => }/test/input.txt | 2 +- .../windows/{nt => }/test/stderr.factor | 10 +- .../io/launcher/windows/windows-tests.factor | 197 ++++++++++- basis/io/launcher/windows/windows.factor | 118 ++++++- basis/io/mmap/windows/windows.factor | 2 +- basis/io/monitors/monitors-tests.factor | 2 +- basis/io/monitors/monitors.factor | 2 +- .../io/monitors/windows/{nt => }/authors.txt | 0 basis/io/monitors/windows/nt/nt-tests.factor | 4 - basis/io/monitors/windows/nt/platforms.txt | 1 - .../nt => monitors/windows}/platforms.txt | 0 .../windows/{nt/nt.factor => windows.factor} | 6 +- basis/io/pipes/pipes.factor | 2 +- basis/io/pipes/windows/{nt => }/authors.txt | 0 basis/io/pipes/windows/nt/platforms.txt | 1 - .../windows}/platforms.txt | 0 .../windows/{nt/nt.factor => windows.factor} | 11 +- basis/io/sockets/sockets.factor | 2 +- .../nt => sockets/windows}/authors.txt | 0 basis/io/sockets/windows/nt/authors.txt | 3 - basis/io/sockets/windows/nt/nt.factor | 224 ------------- basis/io/sockets/windows/nt/platforms.txt | 1 - basis/io/sockets/windows/windows.factor | 225 ++++++++++++- basis/system-info/windows/ce/ce.factor | 33 -- basis/system-info/windows/ce/platforms.txt | 1 - basis/system-info/windows/nt/authors.txt | 1 - basis/system-info/windows/nt/nt.factor | 47 --- basis/system-info/windows/nt/platforms.txt | 1 - .../nt-tests.factor => windows-tests.factor} | 5 +- basis/system-info/windows/windows.factor | 52 ++- basis/tools/deploy/windows/windows.factor | 2 +- basis/ui/backend/windows/windows.factor | 2 +- basis/windows/ce/authors.txt | 1 - basis/windows/ce/ce.factor | 14 - basis/windows/ce/platforms.txt | 1 - basis/windows/nt/authors.txt | 1 - basis/windows/nt/nt.factor | 35 -- basis/windows/nt/platforms.txt | 1 - .../ce => windows/privileges}/authors.txt | 0 .../windows/privileges/platforms.txt | 0 .../privileges/privileges-tests.factor | 4 + .../privileges/privileges.factor | 21 +- basis/windows/windows.factor | 36 +++ unmaintained/ce/authors.txt | 1 - unmaintained/ce/backend/authors.txt | 3 - unmaintained/ce/backend/backend.factor | 50 --- unmaintained/ce/ce.factor | 11 - unmaintained/ce/files/authors.txt | 2 - unmaintained/ce/files/files.factor | 32 -- unmaintained/ce/privileges/privileges.factor | 4 - unmaintained/ce/sockets/authors.txt | 2 - unmaintained/ce/sockets/sockets.factor | 113 ------- unmaintained/ce/summary.txt | 1 - vm/Config.windows | 17 +- vm/Config.windows.ce | 5 - vm/Config.windows.ce.arm | 4 - vm/Config.windows.nt | 10 - ...indows.nt.x86.32 => Config.windows.x86.32} | 4 +- ...indows.nt.x86.64 => Config.windows.x86.64} | 4 +- vm/code_heap.cpp | 2 +- vm/main-windows-ce.cpp | 132 -------- vm/{main-windows-nt.cpp => main-windows.cpp} | 0 vm/{mvm-windows-nt.cpp => mvm-windows.cpp} | 0 vm/os-windows-ce.cpp | 30 -- vm/os-windows-ce.hpp | 27 -- vm/os-windows-nt.cpp | 100 ------ vm/os-windows-nt.hpp | 42 --- ...ws-nt-x86.32.cpp => os-windows-x86.32.cpp} | 0 ...ws-nt-x86.64.cpp => os-windows-x86.64.cpp} | 0 ...os-windows-nt.32.hpp => os-windows.32.hpp} | 0 ...os-windows-nt.64.hpp => os-windows.64.hpp} | 0 vm/os-windows.cpp | 92 ++++++ vm/os-windows.hpp | 41 ++- vm/platform.hpp | 10 +- 96 files changed, 1079 insertions(+), 1653 deletions(-) delete mode 100755 basis/io/backend/windows/nt/nt.factor delete mode 100644 basis/io/backend/windows/privileges/privileges-tests.factor delete mode 100644 basis/io/backend/windows/privileges/privileges.factor delete mode 100755 basis/io/files/windows/nt/authors.txt delete mode 100644 basis/io/files/windows/nt/nt.factor delete mode 100644 basis/io/files/windows/nt/platforms.txt rename basis/io/files/windows/{nt/nt-tests.factor => windows-tests.factor} (91%) delete mode 100755 basis/io/launcher/windows/nt/authors.txt delete mode 100755 basis/io/launcher/windows/nt/nt-tests.factor delete mode 100644 basis/io/launcher/windows/nt/nt.factor delete mode 100644 basis/io/launcher/windows/nt/platforms.txt rename basis/io/launcher/windows/{nt => }/test/append.factor (93%) rename basis/io/launcher/windows/{nt => }/test/env.factor (100%) rename basis/io/launcher/windows/{nt => }/test/input.txt (95%) mode change 100755 => 100644 rename basis/io/launcher/windows/{nt => }/test/stderr.factor (95%) rename basis/io/monitors/windows/{nt => }/authors.txt (100%) mode change 100755 => 100644 delete mode 100644 basis/io/monitors/windows/nt/nt-tests.factor delete mode 100644 basis/io/monitors/windows/nt/platforms.txt rename basis/io/{backend/windows/nt => monitors/windows}/platforms.txt (100%) rename basis/io/monitors/windows/{nt/nt.factor => windows.factor} (95%) rename basis/io/pipes/windows/{nt => }/authors.txt (100%) mode change 100755 => 100644 delete mode 100644 basis/io/pipes/windows/nt/platforms.txt rename basis/io/{backend/windows/nt/privileges => pipes/windows}/platforms.txt (100%) rename basis/io/pipes/windows/{nt/nt.factor => windows.factor} (77%) rename basis/io/{backend/windows/nt => sockets/windows}/authors.txt (100%) mode change 100755 => 100644 delete mode 100755 basis/io/sockets/windows/nt/authors.txt delete mode 100644 basis/io/sockets/windows/nt/nt.factor delete mode 100644 basis/io/sockets/windows/nt/platforms.txt delete mode 100644 basis/system-info/windows/ce/ce.factor delete mode 100644 basis/system-info/windows/ce/platforms.txt delete mode 100755 basis/system-info/windows/nt/authors.txt delete mode 100644 basis/system-info/windows/nt/nt.factor delete mode 100644 basis/system-info/windows/nt/platforms.txt rename basis/system-info/windows/{nt/nt-tests.factor => windows-tests.factor} (58%) mode change 100755 => 100644 delete mode 100644 basis/windows/ce/authors.txt delete mode 100644 basis/windows/ce/ce.factor delete mode 100644 basis/windows/ce/platforms.txt delete mode 100644 basis/windows/nt/authors.txt delete mode 100644 basis/windows/nt/nt.factor delete mode 100644 basis/windows/nt/platforms.txt rename basis/{system-info/windows/ce => windows/privileges}/authors.txt (100%) mode change 100755 => 100644 rename basis/{io/backend => }/windows/privileges/platforms.txt (100%) create mode 100644 basis/windows/privileges/privileges-tests.factor rename basis/{io/backend/windows/nt => windows}/privileges/privileges.factor (70%) delete mode 100644 unmaintained/ce/authors.txt delete mode 100755 unmaintained/ce/backend/authors.txt delete mode 100644 unmaintained/ce/backend/backend.factor delete mode 100644 unmaintained/ce/ce.factor delete mode 100755 unmaintained/ce/files/authors.txt delete mode 100644 unmaintained/ce/files/files.factor delete mode 100644 unmaintained/ce/privileges/privileges.factor delete mode 100755 unmaintained/ce/sockets/authors.txt delete mode 100644 unmaintained/ce/sockets/sockets.factor delete mode 100644 unmaintained/ce/summary.txt delete mode 100644 vm/Config.windows.ce delete mode 100644 vm/Config.windows.ce.arm delete mode 100644 vm/Config.windows.nt rename vm/{Config.windows.nt.x86.32 => Config.windows.x86.32} (51%) rename vm/{Config.windows.nt.x86.64 => Config.windows.x86.64} (63%) delete mode 100755 vm/main-windows-ce.cpp rename vm/{main-windows-nt.cpp => main-windows.cpp} (100%) mode change 100755 => 100644 rename vm/{mvm-windows-nt.cpp => mvm-windows.cpp} (100%) delete mode 100644 vm/os-windows-ce.cpp delete mode 100755 vm/os-windows-ce.hpp delete mode 100755 vm/os-windows-nt.cpp delete mode 100755 vm/os-windows-nt.hpp rename vm/{os-windows-nt-x86.32.cpp => os-windows-x86.32.cpp} (100%) rename vm/{os-windows-nt-x86.64.cpp => os-windows-x86.64.cpp} (100%) rename vm/{os-windows-nt.32.hpp => os-windows.32.hpp} (100%) mode change 100755 => 100644 rename vm/{os-windows-nt.64.hpp => os-windows.64.hpp} (100%) mode change 100755 => 100644 diff --git a/GNUmakefile b/GNUmakefile index 09aa5ee6bf..38e3b0d736 100755 --- a/GNUmakefile +++ b/GNUmakefile @@ -96,7 +96,6 @@ help: @echo "macosx-ppc" @echo "solaris-x86-32" @echo "solaris-x86-64" - @echo "wince-arm" @echo "winnt-x86-32" @echo "winnt-x86-64" @echo "" @@ -162,9 +161,6 @@ winnt-x86-64: $(MAKE) $(ALL) CONFIG=vm/Config.windows.nt.x86.64 $(MAKE) factor-console CONFIG=vm/Config.windows.nt.x86.64 -wince-arm: - $(MAKE) $(ALL) CONFIG=vm/Config.windows.ce.arm - ifdef CONFIG macosx.app: factor diff --git a/Nmakefile b/Nmakefile index 5297e49171..c6f24da08a 100755 --- a/Nmakefile +++ b/Nmakefile @@ -14,18 +14,17 @@ CL_FLAGS = $(CL_FLAGS) /Zi /DFACTOR_DEBUG !IF "$(PLATFORM)" == "x86-32" LINK_FLAGS = $(LINK_FLAGS) /safeseh -PLAF_DLL_OBJS = vm\os-windows-nt-x86.32.obj vm\safeseh.obj +PLAF_DLL_OBJS = vm\os-windows-x86.32.obj vm\safeseh.obj !ELSEIF "$(PLATFORM)" == "x86-64" -PLAF_DLL_OBJS = vm\os-windows-nt-x86.64.obj +PLAF_DLL_OBJS = vm\os-windows-x86.64.obj !ENDIF ML_FLAGS = /nologo /safeseh -EXE_OBJS = vm\main-windows-nt.obj vm\factor.res +EXE_OBJS = vm/main-windows.obj vm\factor.res DLL_OBJS = $(PLAF_DLL_OBJS) \ vm\os-windows.obj \ - vm\os-windows-nt.obj \ vm\aging_collector.obj \ vm\alien.obj \ vm\arrays.obj \ @@ -56,7 +55,7 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \ vm\jit.obj \ vm\math.obj \ vm\mvm.obj \ - vm\mvm-windows-nt.obj \ + vm\mvm-windows.obj \ vm\nursery_collector.obj \ vm\object_start_map.obj \ vm\objects.obj \ @@ -68,7 +67,7 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \ vm\to_tenured_collector.obj \ vm\tuples.obj \ vm\utilities.obj \ - vm\vm.obj \ + vm\vm.obj \ vm\words.obj .cpp.obj: diff --git a/basis/bootstrap/io/io.factor b/basis/bootstrap/io/io.factor index b9a49b48b8..5740d44431 100644 --- a/basis/bootstrap/io/io.factor +++ b/basis/bootstrap/io/io.factor @@ -6,6 +6,6 @@ IN: bootstrap.io "io.backend." { { [ "io-backend" get ] [ "io-backend" get ] } { [ os unix? ] [ "unix." os name>> append ] } - { [ os winnt? ] [ "windows.nt" ] } + { [ os windows? ] [ "windows" ] } } cond append require ] when diff --git a/basis/bootstrap/stage2.factor b/basis/bootstrap/stage2.factor index e3e8b5ddbc..c70cf00df3 100644 --- a/basis/bootstrap/stage2.factor +++ b/basis/bootstrap/stage2.factor @@ -72,8 +72,7 @@ SYMBOL: bootstrap-time (command-line) parse-command-line ! Set dll paths - os wince? [ "windows.ce" require ] when - os winnt? [ "windows.nt" require ] when + os windows? [ "windows" require ] when "staging" get "deploy-vocab" get or [ "stage2: deployment mode" print diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor deleted file mode 100755 index b34902f7f1..0000000000 --- a/basis/io/backend/windows/nt/nt.factor +++ /dev/null @@ -1,148 +0,0 @@ -USING: accessors alien alien.c-types alien.data alien.syntax -arrays assocs classes.struct combinators -combinators.short-circuit destructors io io.backend -io.backend.windows io.buffers io.files.windows io.ports -io.streams.c io.streams.null io.timeouts kernel libc locals -math namespaces sequences system threads vocabs.loader -windows.errors windows.handles windows.kernel32 ; -IN: io.backend.windows.nt - -! Global variable with assoc mapping overlapped to threads -SYMBOL: pending-overlapped - -TUPLE: io-callback port thread ; - -C: io-callback - -: (make-overlapped) ( -- overlapped-ext ) - OVERLAPPED malloc-struct &free ; - -: make-overlapped ( port -- overlapped-ext ) - [ (make-overlapped) ] dip - handle>> ptr>> [ >>offset ] when* ; - -M: winnt FileArgs-overlapped ( port -- overlapped ) - make-overlapped ; - -: ( handle existing -- handle ) - f 1 CreateIoCompletionPort dup win32-error=0/f ; - -SYMBOL: master-completion-port - -: ( -- handle ) - INVALID_HANDLE_VALUE f ; - -M: winnt add-completion ( win32-handle -- win32-handle ) - dup handle>> master-completion-port get-global drop ; - -: eof? ( error -- ? ) - { [ ERROR_HANDLE_EOF = ] [ ERROR_BROKEN_PIPE = ] } 1|| ; - -: twiddle-thumbs ( overlapped port -- bytes-transferred ) - [ - drop - [ self ] dip >c-ptr pending-overlapped get-global set-at - "I/O" suspend { - { [ dup integer? ] [ ] } - { [ dup array? ] [ - first dup eof? - [ drop 0 ] [ n>win32-error-string throw ] if - ] } - } cond - ] with-timeout ; - -:: wait-for-overlapped ( nanos -- bytes-transferred overlapped error? ) - nanos [ 1,000,000 /i ] [ INFINITE ] if* :> timeout - master-completion-port get-global - { int void* pointer: OVERLAPPED } - [ timeout GetQueuedCompletionStatus zero? ] with-out-parameters - :> ( error? bytes key overlapped ) - bytes overlapped error? ; - -: resume-callback ( result overlapped -- ) - >c-ptr pending-overlapped get-global delete-at* drop resume-with ; - -: handle-overlapped ( nanos -- ? ) - wait-for-overlapped [ - [ - [ drop GetLastError 1array ] dip resume-callback t - ] [ drop f ] if* - ] [ resume-callback t ] if ; - -M: win32-handle cancel-operation - [ handle>> CancelIo win32-error=0/f ] unless-disposed ; - -M: winnt io-multiplex ( nanos -- ) - handle-overlapped [ 0 io-multiplex ] when ; - -M: winnt init-io ( -- ) - master-completion-port set-global - H{ } clone pending-overlapped set-global ; - -ERROR: invalid-file-size n ; - -: handle>file-size ( handle -- n ) - 0 [ GetFileSizeEx win32-error=0/f ] keep *ulonglong ; - -ERROR: seek-before-start n ; - -: set-seek-ptr ( n handle -- ) - [ dup 0 < [ seek-before-start ] when ] dip ptr<< ; - -M: winnt tell-handle ( handle -- n ) ptr>> ; - -M: winnt seek-handle ( n seek-type handle -- ) - swap { - { seek-absolute [ set-seek-ptr ] } - { seek-relative [ [ ptr>> + ] keep set-seek-ptr ] } - { seek-end [ [ handle>> handle>file-size + ] keep set-seek-ptr ] } - [ bad-seek-type ] - } case ; - -: file-error? ( n -- eof? ) - zero? [ - GetLastError { - { [ dup expected-io-error? ] [ drop f ] } - { [ dup eof? ] [ drop t ] } - [ n>win32-error-string throw ] - } cond - ] [ f ] if ; - -: wait-for-file ( FileArgs n port -- n ) - swap file-error? - [ 2drop 0 ] [ [ lpOverlapped>> ] dip twiddle-thumbs ] if ; - -: update-file-ptr ( n port -- ) - handle>> dup ptr>> [ rot + >>ptr drop ] [ 2drop ] if* ; - -: finish-write ( n port -- ) - [ update-file-ptr ] [ buffer>> buffer-consume ] 2bi ; - -M: winnt (wait-to-write) - [ - [ make-FileArgs dup setup-write WriteFile ] - [ wait-for-file ] - [ finish-write ] - tri - ] with-destructors ; - -: finish-read ( n port -- ) - [ update-file-ptr ] [ buffer>> n>buffer ] 2bi ; - -M: winnt (wait-to-read) ( port -- ) - [ - [ make-FileArgs dup setup-read ReadFile ] - [ wait-for-file ] - [ finish-read ] - tri - ] with-destructors ; - -: console-app? ( -- ? ) GetConsoleWindow >boolean ; - -M: winnt init-stdio - console-app? - [ init-c-stdio ] - [ null-reader null-writer null-writer set-stdio ] if ; - -"io.files.windows.nt" require -winnt set-io-backend diff --git a/basis/io/backend/windows/privileges/privileges-tests.factor b/basis/io/backend/windows/privileges/privileges-tests.factor deleted file mode 100644 index a66b2aad7a..0000000000 --- a/basis/io/backend/windows/privileges/privileges-tests.factor +++ /dev/null @@ -1,4 +0,0 @@ -USING: io.backend.windows.privileges tools.test ; -IN: io.backend.windows.privileges.tests - -[ [ ] with-privileges ] must-infer diff --git a/basis/io/backend/windows/privileges/privileges.factor b/basis/io/backend/windows/privileges/privileges.factor deleted file mode 100644 index 58806cc4df..0000000000 --- a/basis/io/backend/windows/privileges/privileges.factor +++ /dev/null @@ -1,15 +0,0 @@ -USING: io.backend kernel continuations sequences -system vocabs.loader combinators fry ; -IN: io.backend.windows.privileges - -HOOK: set-privilege io-backend ( name ? -- ) - -: with-privileges ( seq quot -- ) - [ '[ _ [ t set-privilege ] each @ ] ] - [ drop '[ _ [ f set-privilege ] each ] ] - 2bi [ ] cleanup ; inline - -{ - { [ os winnt? ] [ "io.backend.windows.nt.privileges" require ] } - { [ os wince? ] [ "io.backend.windows.ce.privileges" require ] } -} cond diff --git a/basis/io/backend/windows/windows.factor b/basis/io/backend/windows/windows.factor index 7ecb5765a1..7f9c42d13b 100755 --- a/basis/io/backend/windows/windows.factor +++ b/basis/io/backend/windows/windows.factor @@ -1,34 +1,8 @@ ! Copyright (C) 2004, 2010 Mackenzie Straight, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types classes.struct destructors -io.backend io.timeouts kernel literals windows.errors -windows.handles windows.kernel32 vocabs.loader ; +USING: io.backend namespaces system vocabs.loader ; IN: io.backend.windows -HOOK: CreateFile-flags io-backend ( DWORD -- DWORD ) -HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) -HOOK: add-completion io-backend ( port -- port ) +"io.files.windows" require -TUPLE: win32-file < win32-handle ptr ; - -: ( handle -- win32-file ) - win32-file new-win32-handle ; - -M: win32-file dispose - [ cancel-operation ] [ call-next-method ] bi ; - -: opened-file ( handle -- win32-file ) - check-invalid-handle |dispose add-completion ; - -CONSTANT: share-mode - flags{ - FILE_SHARE_READ - FILE_SHARE_WRITE - FILE_SHARE_DELETE - } - -: default-security-attributes ( -- obj ) - SECURITY_ATTRIBUTES - SECURITY_ATTRIBUTES heap-size >>nLength ; - -"io.files.windows" require \ No newline at end of file +winnt set-io-backend diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index 2971a15b4b..bf055f327b 100755 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! 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 +io.files.windows kernel windows.kernel32 windows.time windows.types windows accessors alien.c-types combinators generalizations system alien.strings io.encodings.utf16n sequences splitting windows.errors fry diff --git a/basis/io/files/unique/windows/windows.factor b/basis/io/files/unique/windows/windows.factor index 2c722426dc..f4b88ff21e 100644 --- a/basis/io/files/unique/windows/windows.factor +++ b/basis/io/files/unique/windows/windows.factor @@ -1,6 +1,5 @@ -USING: kernel system windows.kernel32 io.backend.windows -io.files.windows io.ports windows destructors environment -io.files.unique ; +USING: destructors environment io.files.unique io.files.windows +system windows.kernel32 ; IN: io.files.unique.windows M: windows (touch-unique-file) ( path -- ) diff --git a/basis/io/files/windows/nt/authors.txt b/basis/io/files/windows/nt/authors.txt deleted file mode 100755 index 026f4cd0de..0000000000 --- a/basis/io/files/windows/nt/authors.txt +++ /dev/null @@ -1,3 +0,0 @@ -Doug Coleman -Slava Pestov -Mackenzie Straight diff --git a/basis/io/files/windows/nt/nt.factor b/basis/io/files/windows/nt/nt.factor deleted file mode 100644 index 4046522a1b..0000000000 --- a/basis/io/files/windows/nt/nt.factor +++ /dev/null @@ -1,65 +0,0 @@ -USING: accessors alien.c-types alien.strings classes.struct -combinators combinators.short-circuit continuations environment -io.backend io.backend.windows io.encodings.utf16n -io.files.private io.files.windows io.pathnames kernel math -sequences specialized-arrays system tr -windows windows.errors windows.kernel32 windows.shell32 -windows.time ; -SPECIALIZED-ARRAY: ushort -IN: io.files.windows.nt - -M: winnt cwd - MAX_UNICODE_PATH dup - [ GetCurrentDirectory win32-error=0/f ] keep - utf16n alien>string ; - -M: winnt cd - SetCurrentDirectory win32-error=0/f ; - -CONSTANT: unicode-prefix "\\\\?\\" - -M: winnt root-directory? ( path -- ? ) - { - { [ dup empty? ] [ drop f ] } - { [ dup [ path-separator? ] all? ] [ drop t ] } - { [ dup trim-tail-separators { [ length 2 = ] - [ second CHAR: : = ] } 1&& ] [ drop t ] } - { [ dup unicode-prefix head? ] - [ trim-tail-separators length unicode-prefix length 2 + = ] } - [ drop f ] - } cond ; - -: prepend-prefix ( string -- string' ) - dup unicode-prefix head? [ - unicode-prefix prepend - ] unless ; - -TR: normalize-separators "/" "\\" ; - -M: winnt normalize-path ( string -- string' ) - absolute-path - normalize-separators - prepend-prefix ; - -M: winnt CreateFile-flags ( DWORD -- DWORD ) - FILE_FLAG_OVERLAPPED bitor ; - - - [ GetFileAttributesEx win32-error=0/f ] keep - [ nFileSizeLow>> ] [ nFileSizeHigh>> ] bi >64bit ; - -PRIVATE> - -M: winnt open-append - [ dup windows-file-size ] [ drop 0 ] recover - [ (open-append) ] dip >>ptr ; - -M: winnt home - { - [ "HOMEDRIVE" os-env "HOMEPATH" os-env append-path ] - [ "USERPROFILE" os-env ] - [ my-documents ] - } 0|| ; diff --git a/basis/io/files/windows/nt/platforms.txt b/basis/io/files/windows/nt/platforms.txt deleted file mode 100644 index 205e64323d..0000000000 --- a/basis/io/files/windows/nt/platforms.txt +++ /dev/null @@ -1 +0,0 @@ -winnt diff --git a/basis/io/files/windows/nt/nt-tests.factor b/basis/io/files/windows/windows-tests.factor similarity index 91% rename from basis/io/files/windows/nt/nt-tests.factor rename to basis/io/files/windows/windows-tests.factor index a142bb844e..d7d9080057 100644 --- a/basis/io/files/windows/nt/nt-tests.factor +++ b/basis/io/files/windows/windows-tests.factor @@ -1,6 +1,8 @@ +! Copyright (C) 2010 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: io.files io.pathnames kernel tools.test io.backend -io.files.windows.nt splitting sequences io.pathnames.private ; -IN: io.files.windows.nt.tests +io.files.windows splitting sequences io.pathnames.private ; +IN: io.files.windows.tests [ f ] [ "\\foo" absolute-path? ] unit-test [ t ] [ "\\\\?\\c:\\foo" absolute-path? ] unit-test diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 3b4df85371..024b278b4b 100644 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -1,12 +1,216 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types alien.data combinators -destructors io.backend.windows io.binary io.buffers io.files -io.files.types io.ports kernel literals make -math.bitwise system windows.errors windows.handles -windows.kernel32 windows.time windows.types vocabs.loader ; +USING: accessors alien alien.c-types alien.data alien.strings +alien.syntax arrays assocs classes.struct combinators +combinators.short-circuit continuations destructors environment +io io.backend io.binary io.buffers +io.encodings.utf16n io.files io.files.private io.files.types +io.pathnames io.ports io.streams.c io.streams.null io.timeouts +kernel libc literals locals make math math.bitwise namespaces +sequences specialized-arrays system +threads tr windows windows.errors windows.handles +windows.kernel32 windows.shell32 windows.time windows.types ; +SPECIALIZED-ARRAY: ushort IN: io.files.windows +HOOK: CreateFile-flags io-backend ( DWORD -- DWORD ) +HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) +HOOK: add-completion io-backend ( port -- port ) +HOOK: open-append os ( path -- win32-file ) + +TUPLE: win32-file < win32-handle ptr ; + +: ( handle -- win32-file ) + win32-file new-win32-handle ; + +M: win32-file dispose + [ cancel-operation ] [ call-next-method ] bi ; + +: opened-file ( handle -- win32-file ) + check-invalid-handle |dispose add-completion ; + +CONSTANT: share-mode + flags{ + FILE_SHARE_READ + FILE_SHARE_WRITE + FILE_SHARE_DELETE + } + +: default-security-attributes ( -- obj ) + SECURITY_ATTRIBUTES + SECURITY_ATTRIBUTES heap-size >>nLength ; + +TUPLE: FileArgs + hFile lpBuffer nNumberOfBytesToRead + lpNumberOfBytesRet lpOverlapped ; + +C: FileArgs + +: make-FileArgs ( port -- ) + { + [ handle>> check-disposed ] + [ handle>> handle>> ] + [ buffer>> ] + [ buffer>> buffer-length ] + [ drop DWORD ] + [ FileArgs-overlapped ] + } cleave ; + +! Global variable with assoc mapping overlapped to threads +SYMBOL: pending-overlapped + +TUPLE: io-callback port thread ; + +C: io-callback + +: (make-overlapped) ( -- overlapped-ext ) + OVERLAPPED malloc-struct &free ; + +: make-overlapped ( port -- overlapped-ext ) + [ (make-overlapped) ] dip + handle>> ptr>> [ >>offset ] when* ; + +M: winnt FileArgs-overlapped ( port -- overlapped ) + make-overlapped ; + +: ( handle existing -- handle ) + f 1 CreateIoCompletionPort dup win32-error=0/f ; + +SYMBOL: master-completion-port + +: ( -- handle ) + INVALID_HANDLE_VALUE f ; + +M: winnt add-completion ( win32-handle -- win32-handle ) + dup handle>> master-completion-port get-global drop ; + +: eof? ( error -- ? ) + { [ ERROR_HANDLE_EOF = ] [ ERROR_BROKEN_PIPE = ] } 1|| ; + +: twiddle-thumbs ( overlapped port -- bytes-transferred ) + [ + drop + [ self ] dip >c-ptr pending-overlapped get-global set-at + "I/O" suspend { + { [ dup integer? ] [ ] } + { [ dup array? ] [ + first dup eof? + [ drop 0 ] [ n>win32-error-string throw ] if + ] } + } cond + ] with-timeout ; + +:: wait-for-overlapped ( nanos -- bytes-transferred overlapped error? ) + nanos [ 1,000,000 /i ] [ INFINITE ] if* :> timeout + master-completion-port get-global + { int void* pointer: OVERLAPPED } + [ timeout GetQueuedCompletionStatus zero? ] with-out-parameters + :> ( error? bytes key overlapped ) + bytes overlapped error? ; + +: resume-callback ( result overlapped -- ) + >c-ptr pending-overlapped get-global delete-at* drop resume-with ; + +: handle-overlapped ( nanos -- ? ) + wait-for-overlapped [ + [ + [ drop GetLastError 1array ] dip resume-callback t + ] [ drop f ] if* + ] [ resume-callback t ] if ; + +M: win32-handle cancel-operation + [ handle>> CancelIo win32-error=0/f ] unless-disposed ; + +M: winnt io-multiplex ( nanos -- ) + handle-overlapped [ 0 io-multiplex ] when ; + +M: winnt init-io ( -- ) + master-completion-port set-global + H{ } clone pending-overlapped set-global ; + +ERROR: invalid-file-size n ; + +: handle>file-size ( handle -- n ) + 0 [ GetFileSizeEx win32-error=0/f ] keep *ulonglong ; + +ERROR: seek-before-start n ; + +: set-seek-ptr ( n handle -- ) + [ dup 0 < [ seek-before-start ] when ] dip ptr<< ; + +M: winnt tell-handle ( handle -- n ) ptr>> ; + +M: winnt seek-handle ( n seek-type handle -- ) + swap { + { seek-absolute [ set-seek-ptr ] } + { seek-relative [ [ ptr>> + ] keep set-seek-ptr ] } + { seek-end [ [ handle>> handle>file-size + ] keep set-seek-ptr ] } + [ bad-seek-type ] + } case ; + +: file-error? ( n -- eof? ) + zero? [ + GetLastError { + { [ dup expected-io-error? ] [ drop f ] } + { [ dup eof? ] [ drop t ] } + [ n>win32-error-string throw ] + } cond + ] [ f ] if ; + +: wait-for-file ( FileArgs n port -- n ) + swap file-error? + [ 2drop 0 ] [ [ lpOverlapped>> ] dip twiddle-thumbs ] if ; + +: update-file-ptr ( n port -- ) + handle>> dup ptr>> [ rot + >>ptr drop ] [ 2drop ] if* ; + +: finish-write ( n port -- ) + [ update-file-ptr ] [ buffer>> buffer-consume ] 2bi ; + +: setup-read ( -- hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRead lpOverlapped ) + { + [ hFile>> ] + [ lpBuffer>> buffer-end ] + [ lpBuffer>> buffer-capacity ] + [ lpNumberOfBytesRet>> ] + [ lpOverlapped>> ] + } cleave ; + +: setup-write ( -- hFile lpBuffer nNumberOfBytesToWrite lpNumberOfBytesWritten lpOverlapped ) + { + [ hFile>> ] + [ lpBuffer>> buffer@ ] + [ lpBuffer>> buffer-length ] + [ lpNumberOfBytesRet>> ] + [ lpOverlapped>> ] + } cleave ; + +M: winnt (wait-to-write) + [ + [ make-FileArgs dup setup-write WriteFile ] + [ wait-for-file ] + [ finish-write ] + tri + ] with-destructors ; + +: finish-read ( n port -- ) + [ update-file-ptr ] [ buffer>> n>buffer ] 2bi ; + +M: winnt (wait-to-read) ( port -- ) + [ + [ make-FileArgs dup setup-read ReadFile ] + [ wait-for-file ] + [ finish-read ] + tri + ] with-destructors ; + +: console-app? ( -- ? ) GetConsoleWindow >boolean ; + +M: winnt init-stdio + console-app? + [ init-c-stdio ] + [ null-reader null-writer null-writer set-stdio ] if ; + : open-file ( path access-mode create-mode flags -- handle ) [ [ share-mode default-security-attributes ] 2dip @@ -48,42 +252,6 @@ IN: io.files.windows [ [ handle>> ] dip d>w/w ] dip SetFilePointer INVALID_SET_FILE_POINTER = [ "SetFilePointer failed" throw ] when ; -HOOK: open-append os ( path -- win32-file ) - -TUPLE: FileArgs - hFile lpBuffer nNumberOfBytesToRead - lpNumberOfBytesRet lpOverlapped ; - -C: FileArgs - -: make-FileArgs ( port -- ) - { - [ handle>> check-disposed ] - [ handle>> handle>> ] - [ buffer>> ] - [ buffer>> buffer-length ] - [ drop DWORD ] - [ FileArgs-overlapped ] - } cleave ; - -: setup-read ( -- hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRead lpOverlapped ) - { - [ hFile>> ] - [ lpBuffer>> buffer-end ] - [ lpBuffer>> buffer-capacity ] - [ lpNumberOfBytesRet>> ] - [ lpOverlapped>> ] - } cleave ; - -: setup-write ( -- hFile lpBuffer nNumberOfBytesToWrite lpNumberOfBytesWritten lpOverlapped ) - { - [ hFile>> ] - [ lpBuffer>> buffer@ ] - [ lpBuffer>> buffer-length ] - [ lpNumberOfBytesRet>> ] - [ lpOverlapped>> ] - } cleave ; - M: windows (file-reader) ( path -- stream ) open-read ; @@ -128,4 +296,58 @@ SYMBOLS: +read-only+ +hidden+ +system+ [ timestamp>FILETIME ] tri@ SetFileTime win32-error=0/f ; -"io.files.windows.nt" require \ No newline at end of file +M: winnt cwd + MAX_UNICODE_PATH dup + [ GetCurrentDirectory win32-error=0/f ] keep + utf16n alien>string ; + +M: winnt cd + SetCurrentDirectory win32-error=0/f ; + +CONSTANT: unicode-prefix "\\\\?\\" + +M: winnt root-directory? ( path -- ? ) + { + { [ dup empty? ] [ drop f ] } + { [ dup [ path-separator? ] all? ] [ drop t ] } + { [ dup trim-tail-separators { [ length 2 = ] + [ second CHAR: : = ] } 1&& ] [ drop t ] } + { [ dup unicode-prefix head? ] + [ trim-tail-separators length unicode-prefix length 2 + = ] } + [ drop f ] + } cond ; + +: prepend-prefix ( string -- string' ) + dup unicode-prefix head? [ + unicode-prefix prepend + ] unless ; + +TR: normalize-separators "/" "\\" ; + +M: winnt normalize-path ( string -- string' ) + absolute-path + normalize-separators + prepend-prefix ; + +M: winnt CreateFile-flags ( DWORD -- DWORD ) + FILE_FLAG_OVERLAPPED bitor ; + + + [ GetFileAttributesEx win32-error=0/f ] keep + [ nFileSizeLow>> ] [ nFileSizeHigh>> ] bi >64bit ; + +PRIVATE> + +M: winnt open-append + [ dup windows-file-size ] [ drop 0 ] recover + [ (open-append) ] dip >>ptr ; + +M: winnt home + { + [ "HOMEDRIVE" os-env "HOMEPATH" os-env append-path ] + [ "USERPROFILE" os-env ] + [ my-documents ] + } 0|| ; \ No newline at end of file diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index dfbbd33d2e..24d1d8e7b8 100755 --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -272,6 +272,6 @@ M: output-process-error error. { { [ os unix? ] [ "io.launcher.unix" require ] } - { [ os winnt? ] [ "io.launcher.windows.nt" require ] } + { [ os windows? ] [ "io.launcher.windows" require ] } [ ] } cond diff --git a/basis/io/launcher/windows/nt/authors.txt b/basis/io/launcher/windows/nt/authors.txt deleted file mode 100755 index 026f4cd0de..0000000000 --- a/basis/io/launcher/windows/nt/authors.txt +++ /dev/null @@ -1,3 +0,0 @@ -Doug Coleman -Slava Pestov -Mackenzie Straight diff --git a/basis/io/launcher/windows/nt/nt-tests.factor b/basis/io/launcher/windows/nt/nt-tests.factor deleted file mode 100755 index c97c411d2c..0000000000 --- a/basis/io/launcher/windows/nt/nt-tests.factor +++ /dev/null @@ -1,196 +0,0 @@ -USING: io.launcher tools.test calendar accessors environment -namespaces kernel system arrays io io.files io.encodings.ascii -sequences parser assocs hashtables math continuations eval -io.files.temp io.directories io.pathnames splitting ; -IN: io.launcher.windows.nt.tests - -[ ] [ - - "notepad" >>command - 1/2 seconds >>timeout - "notepad" set -] unit-test - -[ f ] [ "notepad" get process-running? ] unit-test - -[ f ] [ "notepad" get process-started? ] unit-test - -[ ] [ "notepad" [ run-detached ] change ] unit-test - -[ "notepad" get wait-for-process ] must-fail - -[ t ] [ "notepad" get killed>> ] unit-test - -[ f ] [ "notepad" get process-running? ] unit-test - -[ - - "notepad" >>command - 1/2 seconds >>timeout - try-process -] must-fail - -[ - - "notepad" >>command - 1/2 seconds >>timeout - try-output-process -] must-fail - -: console-vm ( -- path ) - vm ".exe" ?tail [ ".com" append ] when ; - -[ ] [ - - console-vm "-quiet" "-run=hello-world" 3array >>command - "out.txt" temp-file >>stdout - try-process -] unit-test - -[ "Hello world" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ "( scratchpad ) " ] [ - - console-vm "-run=listener" 2array >>command - +closed+ >>stdin - +stdout+ >>stderr - ascii [ lines last ] with-process-reader -] unit-test - -: launcher-test-path ( -- str ) - "resource:basis/io/launcher/windows/nt/test" ; - -[ ] [ - launcher-test-path [ - - console-vm "-script" "stderr.factor" 3array >>command - "out.txt" temp-file >>stdout - "err.txt" temp-file >>stderr - try-process - ] with-directory -] unit-test - -[ "output" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ "error" ] [ - "err.txt" temp-file ascii file-lines first -] unit-test - -[ ] [ - launcher-test-path [ - - console-vm "-script" "stderr.factor" 3array >>command - "out.txt" temp-file >>stdout - +stdout+ >>stderr - try-process - ] with-directory -] unit-test - -[ "outputerror" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ "output" ] [ - launcher-test-path [ - - console-vm "-script" "stderr.factor" 3array >>command - "err2.txt" temp-file >>stderr - ascii stream-lines first - ] with-directory -] unit-test - -[ "error" ] [ - "err2.txt" temp-file ascii file-lines first -] unit-test - -[ t ] [ - launcher-test-path [ - - console-vm "-script" "env.factor" 3array >>command - ascii stream-contents - ] with-directory eval( -- alist ) - - os-envs = -] unit-test - -[ t ] [ - launcher-test-path [ - - console-vm "-script" "env.factor" 3array >>command - +replace-environment+ >>environment-mode - os-envs >>environment - ascii stream-contents - ] with-directory eval( -- alist ) - - os-envs = -] unit-test - -[ "B" ] [ - launcher-test-path [ - - console-vm "-script" "env.factor" 3array >>command - { { "A" "B" } } >>environment - ascii stream-contents - ] with-directory eval( -- alist ) - - "A" swap at -] unit-test - -[ f ] [ - launcher-test-path [ - - console-vm "-script" "env.factor" 3array >>command - { { "USERPROFILE" "XXX" } } >>environment - +prepend-environment+ >>environment-mode - ascii stream-contents - ] with-directory eval( -- alist ) - - "USERPROFILE" swap at "XXX" = -] unit-test - -2 [ - [ ] [ - - "cmd.exe /c dir" >>command - "dir.txt" temp-file >>stdout - try-process - ] unit-test - - [ ] [ "dir.txt" temp-file delete-file ] unit-test -] times - -[ "append-test" temp-file delete-file ] ignore-errors - -[ "Hello appender\r\nHello appender\r\n" ] [ - 2 [ - launcher-test-path [ - - console-vm "-script" "append.factor" 3array >>command - "append-test" temp-file >>stdout - try-process - ] with-directory - ] times - - "append-test" temp-file ascii file-contents -] unit-test - -[ "( scratchpad ) " ] [ - console-vm "-run=listener" 2array - ascii [ "USE: system 0 exit" print flush lines last ] with-process-stream -] unit-test - -[ ] [ - console-vm "-run=listener" 2array - ascii [ "USE: system 0 exit" print ] with-process-writer -] unit-test - -[ ] [ - - console-vm "-run=listener" 2array >>command - "vocab:io/launcher/windows/nt/test/input.txt" >>stdin - try-process -] unit-test diff --git a/basis/io/launcher/windows/nt/nt.factor b/basis/io/launcher/windows/nt/nt.factor deleted file mode 100644 index a9c66d202e..0000000000 --- a/basis/io/launcher/windows/nt/nt.factor +++ /dev/null @@ -1,109 +0,0 @@ -! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types combinators destructors -io.backend io.backend.windows io.files.windows io.launcher -io.launcher.windows io.pipes io.ports kernel locals strings -system windows.errors windows.handles windows.kernel32 -windows.types ; -IN: io.launcher.windows.nt - -: duplicate-handle ( handle -- handle' ) - GetCurrentProcess ! source process - swap handle>> ! handle - GetCurrentProcess ! target process - f [ ! target handle - DUPLICATE_SAME_ACCESS ! desired access - TRUE ! inherit handle - 0 ! options - DuplicateHandle win32-error=0/f - ] keep *void* &dispose ; - -! /dev/null simulation -: null-input ( -- pipe ) - (pipe) [ in>> &dispose ] [ out>> dispose ] bi ; - -: null-output ( -- pipe ) - (pipe) [ out>> &dispose ] [ in>> dispose ] bi ; - -: null-pipe ( mode -- pipe ) - { - { GENERIC_READ [ null-input ] } - { GENERIC_WRITE [ null-output ] } - } case ; - -! The below code is based on the example given in -! http://msdn2.microsoft.com/en-us/library/ms682499.aspx - -: redirect-default ( obj access-mode create-mode -- handle ) - 3drop f ; - -: redirect-closed ( obj access-mode create-mode -- handle ) - drop nip null-pipe ; - -:: redirect-file ( path access-mode create-mode -- handle ) - path normalize-path - access-mode - share-mode - default-security-attributes - create-mode - FILE_ATTRIBUTE_NORMAL ! flags and attributes - f ! template file - CreateFile check-invalid-handle &dispose ; - -: redirect-append ( path access-mode create-mode -- handle ) - [ path>> ] 2dip - drop OPEN_ALWAYS - redirect-file - dup 0 FILE_END set-file-pointer ; - -: redirect-handle ( handle access-mode create-mode -- handle ) - 2drop ; - -: redirect-stream ( stream access-mode create-mode -- handle ) - [ underlying-handle ] 2dip redirect-handle ; - -: redirect ( obj access-mode create-mode -- handle ) - { - { [ pick not ] [ redirect-default ] } - { [ pick +closed+ eq? ] [ redirect-closed ] } - { [ pick string? ] [ redirect-file ] } - { [ pick appender? ] [ redirect-append ] } - { [ pick win32-file? ] [ redirect-handle ] } - [ redirect-stream ] - } cond - dup [ dup t set-inherit handle>> ] when ; - -: redirect-stdout ( process args -- handle ) - drop - stdout>> - GENERIC_WRITE - CREATE_ALWAYS - redirect - STD_OUTPUT_HANDLE GetStdHandle or ; - -: redirect-stderr ( process args -- handle ) - over stderr>> +stdout+ eq? [ - nip - lpStartupInfo>> hStdOutput>> - ] [ - drop - stderr>> - GENERIC_WRITE - CREATE_ALWAYS - redirect - STD_ERROR_HANDLE GetStdHandle or - ] if ; - -: redirect-stdin ( process args -- handle ) - drop - stdin>> - GENERIC_READ - OPEN_EXISTING - redirect - STD_INPUT_HANDLE GetStdHandle or ; - -M: winnt fill-redirection ( process args -- ) - dup lpStartupInfo>> - [ [ redirect-stdout ] dip hStdOutput<< ] - [ [ redirect-stderr ] dip hStdError<< ] - [ [ redirect-stdin ] dip hStdInput<< ] 3tri ; diff --git a/basis/io/launcher/windows/nt/platforms.txt b/basis/io/launcher/windows/nt/platforms.txt deleted file mode 100644 index 205e64323d..0000000000 --- a/basis/io/launcher/windows/nt/platforms.txt +++ /dev/null @@ -1 +0,0 @@ -winnt diff --git a/basis/io/launcher/windows/nt/test/append.factor b/basis/io/launcher/windows/test/append.factor similarity index 93% rename from basis/io/launcher/windows/nt/test/append.factor rename to basis/io/launcher/windows/test/append.factor index 4c1de0c5f9..2943b53f70 100644 --- a/basis/io/launcher/windows/nt/test/append.factor +++ b/basis/io/launcher/windows/test/append.factor @@ -1,2 +1,2 @@ -USE: io -"Hello appender" print +USE: io +"Hello appender" print diff --git a/basis/io/launcher/windows/nt/test/env.factor b/basis/io/launcher/windows/test/env.factor similarity index 100% rename from basis/io/launcher/windows/nt/test/env.factor rename to basis/io/launcher/windows/test/env.factor diff --git a/basis/io/launcher/windows/nt/test/input.txt b/basis/io/launcher/windows/test/input.txt old mode 100755 new mode 100644 similarity index 95% rename from basis/io/launcher/windows/nt/test/input.txt rename to basis/io/launcher/windows/test/input.txt index 99c3cc6fb1..a225e1f1b9 --- a/basis/io/launcher/windows/nt/test/input.txt +++ b/basis/io/launcher/windows/test/input.txt @@ -1 +1 @@ -USE: system 0 exit +USE: system 0 exit diff --git a/basis/io/launcher/windows/nt/test/stderr.factor b/basis/io/launcher/windows/test/stderr.factor similarity index 95% rename from basis/io/launcher/windows/nt/test/stderr.factor rename to basis/io/launcher/windows/test/stderr.factor index f22f50e406..9b2df73860 100644 --- a/basis/io/launcher/windows/nt/test/stderr.factor +++ b/basis/io/launcher/windows/test/stderr.factor @@ -1,5 +1,5 @@ -USE: io -USE: namespaces - -"output" write flush -"error" error-stream get stream-write error-stream get stream-flush +USE: io +USE: namespaces + +"output" write flush +"error" error-stream get stream-write error-stream get stream-flush diff --git a/basis/io/launcher/windows/windows-tests.factor b/basis/io/launcher/windows/windows-tests.factor index 1a3fe823a5..39b5e36cbb 100644 --- a/basis/io/launcher/windows/windows-tests.factor +++ b/basis/io/launcher/windows/windows-tests.factor @@ -1,5 +1,9 @@ +USING: accessors arrays assocs calendar continuations +environment eval hashtables io io.directories +io.encodings.ascii io.files io.files.temp io.launcher +io.launcher.windows io.pathnames kernel math namespaces parser +sequences splitting system tools.test ; IN: io.launcher.windows.tests -USING: tools.test io.launcher.windows ; [ "hello world" ] [ { "hello" "world" } join-arguments ] unit-test @@ -8,3 +12,194 @@ USING: tools.test io.launcher.windows ; [ "bob mac\\\\arthur" ] [ { "bob" "mac\\\\arthur" } join-arguments ] unit-test [ "bob \"mac arthur\\\\\"" ] [ { "bob" "mac arthur\\" } join-arguments ] unit-test + +[ ] [ + + "notepad" >>command + 1/2 seconds >>timeout + "notepad" set +] unit-test + +[ f ] [ "notepad" get process-running? ] unit-test + +[ f ] [ "notepad" get process-started? ] unit-test + +[ ] [ "notepad" [ run-detached ] change ] unit-test + +[ "notepad" get wait-for-process ] must-fail + +[ t ] [ "notepad" get killed>> ] unit-test + +[ f ] [ "notepad" get process-running? ] unit-test + +[ + + "notepad" >>command + 1/2 seconds >>timeout + try-process +] must-fail + +[ + + "notepad" >>command + 1/2 seconds >>timeout + try-output-process +] must-fail + +: console-vm ( -- path ) + vm ".exe" ?tail [ ".com" append ] when ; + +[ ] [ + + console-vm "-quiet" "-run=hello-world" 3array >>command + "out.txt" temp-file >>stdout + try-process +] unit-test + +[ "Hello world" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ "( scratchpad ) " ] [ + + console-vm "-run=listener" 2array >>command + +closed+ >>stdin + +stdout+ >>stderr + ascii [ lines last ] with-process-reader +] unit-test + +: launcher-test-path ( -- str ) + "resource:basis/io/launcher/windows/test" ; + +[ ] [ + launcher-test-path [ + + console-vm "-script" "stderr.factor" 3array >>command + "out.txt" temp-file >>stdout + "err.txt" temp-file >>stderr + try-process + ] with-directory +] unit-test + +[ "output" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ "error" ] [ + "err.txt" temp-file ascii file-lines first +] unit-test + +[ ] [ + launcher-test-path [ + + console-vm "-script" "stderr.factor" 3array >>command + "out.txt" temp-file >>stdout + +stdout+ >>stderr + try-process + ] with-directory +] unit-test + +[ "outputerror" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ "output" ] [ + launcher-test-path [ + + console-vm "-script" "stderr.factor" 3array >>command + "err2.txt" temp-file >>stderr + ascii stream-lines first + ] with-directory +] unit-test + +[ "error" ] [ + "err2.txt" temp-file ascii file-lines first +] unit-test + +[ t ] [ + launcher-test-path [ + + console-vm "-script" "env.factor" 3array >>command + ascii stream-contents + ] with-directory eval( -- alist ) + + os-envs = +] unit-test + +[ t ] [ + launcher-test-path [ + + console-vm "-script" "env.factor" 3array >>command + +replace-environment+ >>environment-mode + os-envs >>environment + ascii stream-contents + ] with-directory eval( -- alist ) + + os-envs = +] unit-test + +[ "B" ] [ + launcher-test-path [ + + console-vm "-script" "env.factor" 3array >>command + { { "A" "B" } } >>environment + ascii stream-contents + ] with-directory eval( -- alist ) + + "A" swap at +] unit-test + +[ f ] [ + launcher-test-path [ + + console-vm "-script" "env.factor" 3array >>command + { { "USERPROFILE" "XXX" } } >>environment + +prepend-environment+ >>environment-mode + ascii stream-contents + ] with-directory eval( -- alist ) + + "USERPROFILE" swap at "XXX" = +] unit-test + +2 [ + [ ] [ + + "cmd.exe /c dir" >>command + "dir.txt" temp-file >>stdout + try-process + ] unit-test + + [ ] [ "dir.txt" temp-file delete-file ] unit-test +] times + +[ "append-test" temp-file delete-file ] ignore-errors + +[ "Hello appender\r\nHello appender\r\n" ] [ + 2 [ + launcher-test-path [ + + console-vm "-script" "append.factor" 3array >>command + "append-test" temp-file >>stdout + try-process + ] with-directory + ] times + + "append-test" temp-file ascii file-contents +] unit-test + +[ "( scratchpad ) " ] [ + console-vm "-run=listener" 2array + ascii [ "USE: system 0 exit" print flush lines last ] with-process-stream +] unit-test + +[ ] [ + console-vm "-run=listener" 2array + ascii [ "USE: system 0 exit" print ] with-process-writer +] unit-test + +[ ] [ + + console-vm "-run=listener" 2array >>command + "vocab:io/launcher/windows/test/input.txt" >>stdin + try-process +] unit-test diff --git a/basis/io/launcher/windows/windows.factor b/basis/io/launcher/windows/windows.factor index ecf730716a..0b58df2e43 100755 --- a/basis/io/launcher/windows/windows.factor +++ b/basis/io/launcher/windows/windows.factor @@ -1,13 +1,14 @@ ! Copyright (C) 2007, 2010 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.data arrays continuations io -io.backend.windows io.pipes.windows.nt io.pathnames libc -io.ports windows.types math windows.kernel32 namespaces make -io.launcher kernel sequences windows.errors splitting system -threads init strings combinators io.backend accessors -concurrency.flags io.files assocs io.files.private windows -destructors classes classes.struct specialized-arrays -debugger prettyprint ; +USING: accessors alien alien.c-types alien.data arrays assocs +classes classes.struct combinators concurrency.flags +continuations debugger destructors init io io.backend +io.backend.windows io.files io.files.private io.files.windows +io.launcher io.pathnames io.pipes io.pipes.windows io.ports +kernel libc locals make math namespaces prettyprint sequences +specialized-arrays splitting +strings system threads windows windows.errors windows.handles +windows.kernel32 windows.types ; SPECIALIZED-ARRAY: ushort SPECIALIZED-ARRAY: void* IN: io.launcher.windows @@ -174,3 +175,104 @@ M: windows wait-for-processes ( -- ? ) WaitForMultipleObjects dup HEX: ffffffff = [ win32-error ] when dup WAIT_TIMEOUT = [ 2drop t ] [ swap nth process-exited f ] if ; + +: duplicate-handle ( handle -- handle' ) + GetCurrentProcess ! source process + swap handle>> ! handle + GetCurrentProcess ! target process + f [ ! target handle + DUPLICATE_SAME_ACCESS ! desired access + TRUE ! inherit handle + 0 ! options + DuplicateHandle win32-error=0/f + ] keep *void* &dispose ; + +! /dev/null simulation +: null-input ( -- pipe ) + (pipe) [ in>> &dispose ] [ out>> dispose ] bi ; + +: null-output ( -- pipe ) + (pipe) [ out>> &dispose ] [ in>> dispose ] bi ; + +: null-pipe ( mode -- pipe ) + { + { GENERIC_READ [ null-input ] } + { GENERIC_WRITE [ null-output ] } + } case ; + +! The below code is based on the example given in +! http://msdn2.microsoft.com/en-us/library/ms682499.aspx + +: redirect-default ( obj access-mode create-mode -- handle ) + 3drop f ; + +: redirect-closed ( obj access-mode create-mode -- handle ) + drop nip null-pipe ; + +:: redirect-file ( path access-mode create-mode -- handle ) + path normalize-path + access-mode + share-mode + default-security-attributes + create-mode + FILE_ATTRIBUTE_NORMAL ! flags and attributes + f ! template file + CreateFile check-invalid-handle &dispose ; + +: redirect-append ( path access-mode create-mode -- handle ) + [ path>> ] 2dip + drop OPEN_ALWAYS + redirect-file + dup 0 FILE_END set-file-pointer ; + +: redirect-handle ( handle access-mode create-mode -- handle ) + 2drop ; + +: redirect-stream ( stream access-mode create-mode -- handle ) + [ underlying-handle ] 2dip redirect-handle ; + +: redirect ( obj access-mode create-mode -- handle ) + { + { [ pick not ] [ redirect-default ] } + { [ pick +closed+ eq? ] [ redirect-closed ] } + { [ pick string? ] [ redirect-file ] } + { [ pick appender? ] [ redirect-append ] } + { [ pick win32-file? ] [ redirect-handle ] } + [ redirect-stream ] + } cond + dup [ dup t set-inherit handle>> ] when ; + +: redirect-stdout ( process args -- handle ) + drop + stdout>> + GENERIC_WRITE + CREATE_ALWAYS + redirect + STD_OUTPUT_HANDLE GetStdHandle or ; + +: redirect-stderr ( process args -- handle ) + over stderr>> +stdout+ eq? [ + nip + lpStartupInfo>> hStdOutput>> + ] [ + drop + stderr>> + GENERIC_WRITE + CREATE_ALWAYS + redirect + STD_ERROR_HANDLE GetStdHandle or + ] if ; + +: redirect-stdin ( process args -- handle ) + drop + stdin>> + GENERIC_READ + OPEN_EXISTING + redirect + STD_INPUT_HANDLE GetStdHandle or ; + +M: winnt fill-redirection ( process args -- ) + dup lpStartupInfo>> + [ [ redirect-stdout ] dip hStdOutput<< ] + [ [ redirect-stderr ] dip hStdError<< ] + [ [ redirect-stdin ] dip hStdInput<< ] 3tri ; diff --git a/basis/io/mmap/windows/windows.factor b/basis/io/mmap/windows/windows.factor index 27382a5118..bd18c12eda 100644 --- a/basis/io/mmap/windows/windows.factor +++ b/basis/io/mmap/windows/windows.factor @@ -1,4 +1,4 @@ -USING: accessors destructors io.backend.windows.privileges +USING: accessors destructors windows.privileges io.files.windows io.mmap io.mmap.private kernel literals locals math math.bitwise system windows.errors windows.handles windows.kernel32 ; diff --git a/basis/io/monitors/monitors-tests.factor b/basis/io/monitors/monitors-tests.factor index ac17c4a39f..d084416030 100644 --- a/basis/io/monitors/monitors-tests.factor +++ b/basis/io/monitors/monitors-tests.factor @@ -1,9 +1,9 @@ -IN: io.monitors.tests USING: io.monitors tools.test io.files system sequences continuations namespaces concurrency.count-downs kernel io threads calendar prettyprint destructors io.timeouts io.files.temp io.directories io.directories.hierarchy io.pathnames accessors concurrency.promises ; +IN: io.monitors.tests os { winnt linux macosx } member? [ [ diff --git a/basis/io/monitors/monitors.factor b/basis/io/monitors/monitors.factor index f3e744a59a..bc9638ce4d 100644 --- a/basis/io/monitors/monitors.factor +++ b/basis/io/monitors/monitors.factor @@ -77,6 +77,6 @@ SYMBOL: +rename-file+ { { [ os macosx? ] [ "io.monitors.macosx" require ] } { [ os linux? ] [ "io.monitors.linux" require ] } - { [ os winnt? ] [ "io.monitors.windows.nt" require ] } + { [ os windows? ] [ "io.monitors.windows" require ] } { [ os bsd? ] [ ] } } cond diff --git a/basis/io/monitors/windows/nt/authors.txt b/basis/io/monitors/windows/authors.txt old mode 100755 new mode 100644 similarity index 100% rename from basis/io/monitors/windows/nt/authors.txt rename to basis/io/monitors/windows/authors.txt diff --git a/basis/io/monitors/windows/nt/nt-tests.factor b/basis/io/monitors/windows/nt/nt-tests.factor deleted file mode 100644 index a7ee649400..0000000000 --- a/basis/io/monitors/windows/nt/nt-tests.factor +++ /dev/null @@ -1,4 +0,0 @@ -IN: io.monitors.windows.nt.tests -USING: io.monitors.windows.nt tools.test ; - - diff --git a/basis/io/monitors/windows/nt/platforms.txt b/basis/io/monitors/windows/nt/platforms.txt deleted file mode 100644 index 205e64323d..0000000000 --- a/basis/io/monitors/windows/nt/platforms.txt +++ /dev/null @@ -1 +0,0 @@ -winnt diff --git a/basis/io/backend/windows/nt/platforms.txt b/basis/io/monitors/windows/platforms.txt similarity index 100% rename from basis/io/backend/windows/nt/platforms.txt rename to basis/io/monitors/windows/platforms.txt diff --git a/basis/io/monitors/windows/nt/nt.factor b/basis/io/monitors/windows/windows.factor similarity index 95% rename from basis/io/monitors/windows/nt/nt.factor rename to basis/io/monitors/windows/windows.factor index e6a055a9d6..8887d718d1 100644 --- a/basis/io/monitors/windows/nt/nt.factor +++ b/basis/io/monitors/windows/windows.factor @@ -3,12 +3,12 @@ USING: alien alien.c-types alien.data alien.strings libc destructors locals kernel math assocs namespaces make continuations sequences hashtables sorting arrays combinators math.bitwise strings -system accessors threads splitting io.backend io.backend.windows -io.backend.windows.nt io.files.windows.nt io.monitors io.ports +system accessors threads splitting io.backend +io.files.windows io.monitors io.ports io.buffers io.files io.timeouts io.encodings.string literals io.encodings.utf16n io windows.errors windows.kernel32 windows.types io.pathnames classes.struct ; -IN: io.monitors.windows.nt +IN: io.monitors.windows : open-directory ( path -- handle ) normalize-path diff --git a/basis/io/pipes/pipes.factor b/basis/io/pipes/pipes.factor index 73de6bf1a2..aee69f640e 100644 --- a/basis/io/pipes/pipes.factor +++ b/basis/io/pipes/pipes.factor @@ -60,6 +60,6 @@ PRIVATE> { { [ os unix? ] [ "io.pipes.unix" require ] } - { [ os winnt? ] [ "io.pipes.windows.nt" require ] } + { [ os windows? ] [ "io.pipes.windows" require ] } [ ] } cond diff --git a/basis/io/pipes/windows/nt/authors.txt b/basis/io/pipes/windows/authors.txt old mode 100755 new mode 100644 similarity index 100% rename from basis/io/pipes/windows/nt/authors.txt rename to basis/io/pipes/windows/authors.txt diff --git a/basis/io/pipes/windows/nt/platforms.txt b/basis/io/pipes/windows/nt/platforms.txt deleted file mode 100644 index 205e64323d..0000000000 --- a/basis/io/pipes/windows/nt/platforms.txt +++ /dev/null @@ -1 +0,0 @@ -winnt diff --git a/basis/io/backend/windows/nt/privileges/platforms.txt b/basis/io/pipes/windows/platforms.txt similarity index 100% rename from basis/io/backend/windows/nt/privileges/platforms.txt rename to basis/io/pipes/windows/platforms.txt diff --git a/basis/io/pipes/windows/nt/nt.factor b/basis/io/pipes/windows/windows.factor similarity index 77% rename from basis/io/pipes/windows/nt/nt.factor rename to basis/io/pipes/windows/windows.factor index d58e5e3d5f..ea906de966 100644 --- a/basis/io/pipes/windows/nt/nt.factor +++ b/basis/io/pipes/windows/windows.factor @@ -1,10 +1,11 @@ ! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types arrays destructors io io.backend.windows libc -windows.types math.bitwise windows.kernel32 windows namespaces -make kernel sequences windows.errors assocs math.parser system -random combinators accessors io.pipes io.ports literals ; -IN: io.pipes.windows.nt +USING: accessors alien alien.c-types arrays assocs combinators +destructors io io.files.windows io.pipes +io.ports kernel libc literals make math.bitwise math.parser +namespaces random sequences system windows windows.errors +windows.kernel32 windows.types ; +IN: io.pipes.windows ! This code is based on ! http://twistedmatrix.com/trac/browser/trunk/twisted/internet/iocpreactor/process.py diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index 30449f066f..b1175a9bb5 100644 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -382,5 +382,5 @@ M: invalid-local-address summary { { [ os unix? ] [ "io.sockets.unix" require ] } - { [ os winnt? ] [ "io.sockets.windows.nt" require ] } + { [ os windows? ] [ "io.sockets.windows" require ] } } cond diff --git a/basis/io/backend/windows/nt/authors.txt b/basis/io/sockets/windows/authors.txt old mode 100755 new mode 100644 similarity index 100% rename from basis/io/backend/windows/nt/authors.txt rename to basis/io/sockets/windows/authors.txt diff --git a/basis/io/sockets/windows/nt/authors.txt b/basis/io/sockets/windows/nt/authors.txt deleted file mode 100755 index 026f4cd0de..0000000000 --- a/basis/io/sockets/windows/nt/authors.txt +++ /dev/null @@ -1,3 +0,0 @@ -Doug Coleman -Slava Pestov -Mackenzie Straight diff --git a/basis/io/sockets/windows/nt/nt.factor b/basis/io/sockets/windows/nt/nt.factor deleted file mode 100644 index 13f399697e..0000000000 --- a/basis/io/sockets/windows/nt/nt.factor +++ /dev/null @@ -1,224 +0,0 @@ -USING: alien alien.accessors alien.c-types alien.data byte-arrays -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 -windows.types ; -IN: io.sockets.windows.nt - -: malloc-int ( n -- alien ) - malloc-byte-array ; inline - -M: winnt WSASocket-flags ( -- DWORD ) - WSA_FLAG_OVERLAPPED ; - -: get-ConnectEx-ptr ( socket -- void* ) - SIO_GET_EXTENSION_FUNCTION_POINTER - WSAID_CONNECTEX - GUID heap-size - { void* } - [ - void* heap-size - DWORD - f - f - WSAIoctl SOCKET_ERROR = [ - winsock-error-string throw - ] when - ] with-out-parameters ; - -TUPLE: ConnectEx-args port - s name namelen lpSendBuffer dwSendDataLength - lpdwBytesSent lpOverlapped ptr ; - -: wait-for-socket ( args -- n ) - [ lpOverlapped>> ] [ port>> ] bi twiddle-thumbs ; inline - -: ( sockaddr size -- ConnectEx ) - ConnectEx-args new - swap >>namelen - swap >>name - f >>lpSendBuffer - 0 >>dwSendDataLength - f >>lpdwBytesSent - (make-overlapped) >>lpOverlapped ; inline - -: call-ConnectEx ( ConnectEx -- ) - { - [ s>> ] - [ name>> ] - [ namelen>> ] - [ lpSendBuffer>> ] - [ dwSendDataLength>> ] - [ lpdwBytesSent>> ] - [ lpOverlapped>> ] - [ ptr>> ] - } cleave - int - { SOCKET void* int PVOID DWORD LPDWORD void* } - stdcall alien-indirect drop - winsock-error-string [ throw ] when* ; inline - -M: object establish-connection ( client-out remote -- ) - make-sockaddr/size - swap >>port - dup port>> handle>> handle>> >>s - dup s>> get-ConnectEx-ptr >>ptr - dup call-ConnectEx - wait-for-socket drop ; - -TUPLE: AcceptEx-args port - sListenSocket sAcceptSocket lpOutputBuffer dwReceiveDataLength - dwLocalAddressLength dwRemoteAddressLength lpdwBytesReceived lpOverlapped ; - -: init-accept-buffer ( addr AcceptEx -- ) - swap sockaddr-size 16 + - [ >>dwLocalAddressLength ] [ >>dwRemoteAddressLength ] bi - dup dwLocalAddressLength>> 2 * malloc &free >>lpOutputBuffer - drop ; inline - -: ( server addr -- AcceptEx ) - AcceptEx-args new - 2dup init-accept-buffer - swap SOCK_STREAM open-socket |dispose handle>> >>sAcceptSocket - over handle>> handle>> >>sListenSocket - swap >>port - 0 >>dwReceiveDataLength - f >>lpdwBytesReceived - (make-overlapped) >>lpOverlapped ; inline - -: call-AcceptEx ( AcceptEx -- ) - { - [ sListenSocket>> ] - [ sAcceptSocket>> ] - [ lpOutputBuffer>> ] - [ dwReceiveDataLength>> ] - [ dwLocalAddressLength>> ] - [ dwRemoteAddressLength>> ] - [ lpdwBytesReceived>> ] - [ lpOverlapped>> ] - } cleave AcceptEx drop - winsock-error-string [ throw ] when* ; inline - -: (extract-remote-address) ( lpOutputBuffer dwReceiveDataLength dwLocalAddressLength dwRemoteAddressLength -- sockaddr ) - f 0 f [ 0 GetAcceptExSockaddrs ] keep *void* ; - -: extract-remote-address ( AcceptEx -- sockaddr ) - [ - { - [ lpOutputBuffer>> ] - [ dwReceiveDataLength>> ] - [ dwLocalAddressLength>> ] - [ dwRemoteAddressLength>> ] - } cleave - (extract-remote-address) - ] [ port>> addr>> protocol-family ] bi - sockaddr-of-family ; inline - -M: object (accept) ( server addr -- handle sockaddr ) - [ - - { - [ call-AcceptEx ] - [ wait-for-socket drop ] - [ sAcceptSocket>> ] - [ extract-remote-address ] - } cleave - ] with-destructors ; - -TUPLE: WSARecvFrom-args port - s lpBuffers dwBufferCount lpNumberOfBytesRecvd - lpFlags lpFrom lpFromLen lpOverlapped lpCompletionRoutine ; - -: make-receive-buffer ( -- WSABUF ) - WSABUF malloc-struct &free - default-buffer-size get - [ >>len ] [ malloc &free >>buf ] bi ; inline - -: ( datagram -- WSARecvFrom ) - WSARecvFrom-args new - swap >>port - dup port>> handle>> handle>> >>s - dup port>> addr>> sockaddr-size - [ malloc &free >>lpFrom ] - [ malloc-int &free >>lpFromLen ] bi - make-receive-buffer >>lpBuffers - 1 >>dwBufferCount - 0 malloc-int &free >>lpFlags - 0 malloc-int &free >>lpNumberOfBytesRecvd - (make-overlapped) >>lpOverlapped ; inline - -: call-WSARecvFrom ( WSARecvFrom -- ) - { - [ s>> ] - [ lpBuffers>> ] - [ dwBufferCount>> ] - [ lpNumberOfBytesRecvd>> ] - [ lpFlags>> ] - [ lpFrom>> ] - [ lpFromLen>> ] - [ lpOverlapped>> ] - [ lpCompletionRoutine>> ] - } cleave WSARecvFrom socket-error* ; inline - -: parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr ) - [ lpBuffers>> buf>> swap memory>byte-array ] - [ - [ port>> addr>> empty-sockaddr dup ] - [ lpFrom>> ] - [ lpFromLen>> *int ] - tri memcpy - ] bi ; inline - -M: winnt (receive) ( datagram -- packet addrspec ) - [ - - [ call-WSARecvFrom ] - [ wait-for-socket ] - [ parse-WSARecvFrom ] - tri - ] with-destructors ; - -TUPLE: WSASendTo-args port - s lpBuffers dwBufferCount lpNumberOfBytesSent - dwFlags lpTo iToLen lpOverlapped lpCompletionRoutine ; - -: make-send-buffer ( packet -- WSABUF ) - [ WSABUF malloc-struct &free ] dip - [ malloc-byte-array &free >>buf ] - [ length >>len ] bi ; inline - -: ( packet addrspec datagram -- WSASendTo ) - WSASendTo-args new - swap >>port - dup port>> handle>> handle>> >>s - swap make-sockaddr/size - [ malloc-byte-array &free ] dip - [ >>lpTo ] [ >>iToLen ] bi* - swap make-send-buffer >>lpBuffers - 1 >>dwBufferCount - 0 >>dwFlags - 0 >>lpNumberOfBytesSent - (make-overlapped) >>lpOverlapped ; inline - -: call-WSASendTo ( WSASendTo -- ) - { - [ s>> ] - [ lpBuffers>> ] - [ dwBufferCount>> ] - [ lpNumberOfBytesSent>> ] - [ dwFlags>> ] - [ lpTo>> ] - [ iToLen>> ] - [ lpOverlapped>> ] - [ lpCompletionRoutine>> ] - } cleave WSASendTo socket-error* ; inline - -M: winnt (send) ( packet addrspec datagram -- ) - [ - - [ call-WSASendTo ] - [ wait-for-socket drop ] - bi - ] with-destructors ; diff --git a/basis/io/sockets/windows/nt/platforms.txt b/basis/io/sockets/windows/nt/platforms.txt deleted file mode 100644 index 205e64323d..0000000000 --- a/basis/io/sockets/windows/nt/platforms.txt +++ /dev/null @@ -1 +0,0 @@ -winnt diff --git a/basis/io/sockets/windows/windows.factor b/basis/io/sockets/windows/windows.factor index d41240d1b3..5dbe56f263 100755 --- a/basis/io/sockets/windows/windows.factor +++ b/basis/io/sockets/windows/windows.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2007, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types classes.struct combinators -destructors io.backend io.backend.windows io.sockets -io.sockets.private kernel system windows.handles -windows.winsock ; +USING: accessors alien alien.c-types alien.data classes.struct +combinators destructors io.backend io.ports +io.sockets io.sockets.private kernel libc math sequences system +windows.handles windows.kernel32 windows.types windows.winsock ; FROM: namespaces => get ; IN: io.sockets.windows @@ -81,3 +81,220 @@ M: object (server) ( addrspec -- handle ) M: windows (datagram) ( addrspec -- handle ) [ SOCK_DGRAM server-socket ] with-destructors ; + + +: malloc-int ( n -- alien ) + malloc-byte-array ; inline + +M: winnt WSASocket-flags ( -- DWORD ) + WSA_FLAG_OVERLAPPED ; + +: get-ConnectEx-ptr ( socket -- void* ) + SIO_GET_EXTENSION_FUNCTION_POINTER + WSAID_CONNECTEX + GUID heap-size + { void* } + [ + void* heap-size + DWORD + f + f + WSAIoctl SOCKET_ERROR = [ + winsock-error-string throw + ] when + ] with-out-parameters ; + +TUPLE: ConnectEx-args port + s name namelen lpSendBuffer dwSendDataLength + lpdwBytesSent lpOverlapped ptr ; + +: wait-for-socket ( args -- n ) + [ lpOverlapped>> ] [ port>> ] bi twiddle-thumbs ; inline + +: ( sockaddr size -- ConnectEx ) + ConnectEx-args new + swap >>namelen + swap >>name + f >>lpSendBuffer + 0 >>dwSendDataLength + f >>lpdwBytesSent + (make-overlapped) >>lpOverlapped ; inline + +: call-ConnectEx ( ConnectEx -- ) + { + [ s>> ] + [ name>> ] + [ namelen>> ] + [ lpSendBuffer>> ] + [ dwSendDataLength>> ] + [ lpdwBytesSent>> ] + [ lpOverlapped>> ] + [ ptr>> ] + } cleave + int + { SOCKET void* int PVOID DWORD LPDWORD void* } + stdcall alien-indirect drop + winsock-error-string [ throw ] when* ; inline + +M: object establish-connection ( client-out remote -- ) + make-sockaddr/size + swap >>port + dup port>> handle>> handle>> >>s + dup s>> get-ConnectEx-ptr >>ptr + dup call-ConnectEx + wait-for-socket drop ; + +TUPLE: AcceptEx-args port + sListenSocket sAcceptSocket lpOutputBuffer dwReceiveDataLength + dwLocalAddressLength dwRemoteAddressLength lpdwBytesReceived lpOverlapped ; + +: init-accept-buffer ( addr AcceptEx -- ) + swap sockaddr-size 16 + + [ >>dwLocalAddressLength ] [ >>dwRemoteAddressLength ] bi + dup dwLocalAddressLength>> 2 * malloc &free >>lpOutputBuffer + drop ; inline + +: ( server addr -- AcceptEx ) + AcceptEx-args new + 2dup init-accept-buffer + swap SOCK_STREAM open-socket |dispose handle>> >>sAcceptSocket + over handle>> handle>> >>sListenSocket + swap >>port + 0 >>dwReceiveDataLength + f >>lpdwBytesReceived + (make-overlapped) >>lpOverlapped ; inline + +: call-AcceptEx ( AcceptEx -- ) + { + [ sListenSocket>> ] + [ sAcceptSocket>> ] + [ lpOutputBuffer>> ] + [ dwReceiveDataLength>> ] + [ dwLocalAddressLength>> ] + [ dwRemoteAddressLength>> ] + [ lpdwBytesReceived>> ] + [ lpOverlapped>> ] + } cleave AcceptEx drop + winsock-error-string [ throw ] when* ; inline + +: (extract-remote-address) ( lpOutputBuffer dwReceiveDataLength dwLocalAddressLength dwRemoteAddressLength -- sockaddr ) + f 0 f [ 0 GetAcceptExSockaddrs ] keep *void* ; + +: extract-remote-address ( AcceptEx -- sockaddr ) + [ + { + [ lpOutputBuffer>> ] + [ dwReceiveDataLength>> ] + [ dwLocalAddressLength>> ] + [ dwRemoteAddressLength>> ] + } cleave + (extract-remote-address) + ] [ port>> addr>> protocol-family ] bi + sockaddr-of-family ; inline + +M: object (accept) ( server addr -- handle sockaddr ) + [ + + { + [ call-AcceptEx ] + [ wait-for-socket drop ] + [ sAcceptSocket>> ] + [ extract-remote-address ] + } cleave + ] with-destructors ; + +TUPLE: WSARecvFrom-args port + s lpBuffers dwBufferCount lpNumberOfBytesRecvd + lpFlags lpFrom lpFromLen lpOverlapped lpCompletionRoutine ; + +: make-receive-buffer ( -- WSABUF ) + WSABUF malloc-struct &free + default-buffer-size get + [ >>len ] [ malloc &free >>buf ] bi ; inline + +: ( datagram -- WSARecvFrom ) + WSARecvFrom-args new + swap >>port + dup port>> handle>> handle>> >>s + dup port>> addr>> sockaddr-size + [ malloc &free >>lpFrom ] + [ malloc-int &free >>lpFromLen ] bi + make-receive-buffer >>lpBuffers + 1 >>dwBufferCount + 0 malloc-int &free >>lpFlags + 0 malloc-int &free >>lpNumberOfBytesRecvd + (make-overlapped) >>lpOverlapped ; inline + +: call-WSARecvFrom ( WSARecvFrom -- ) + { + [ s>> ] + [ lpBuffers>> ] + [ dwBufferCount>> ] + [ lpNumberOfBytesRecvd>> ] + [ lpFlags>> ] + [ lpFrom>> ] + [ lpFromLen>> ] + [ lpOverlapped>> ] + [ lpCompletionRoutine>> ] + } cleave WSARecvFrom socket-error* ; inline + +: parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr ) + [ lpBuffers>> buf>> swap memory>byte-array ] + [ + [ port>> addr>> empty-sockaddr dup ] + [ lpFrom>> ] + [ lpFromLen>> *int ] + tri memcpy + ] bi ; inline + +M: winnt (receive) ( datagram -- packet addrspec ) + [ + + [ call-WSARecvFrom ] + [ wait-for-socket ] + [ parse-WSARecvFrom ] + tri + ] with-destructors ; + +TUPLE: WSASendTo-args port + s lpBuffers dwBufferCount lpNumberOfBytesSent + dwFlags lpTo iToLen lpOverlapped lpCompletionRoutine ; + +: make-send-buffer ( packet -- WSABUF ) + [ WSABUF malloc-struct &free ] dip + [ malloc-byte-array &free >>buf ] + [ length >>len ] bi ; inline + +: ( packet addrspec datagram -- WSASendTo ) + WSASendTo-args new + swap >>port + dup port>> handle>> handle>> >>s + swap make-sockaddr/size + [ malloc-byte-array &free ] dip + [ >>lpTo ] [ >>iToLen ] bi* + swap make-send-buffer >>lpBuffers + 1 >>dwBufferCount + 0 >>dwFlags + 0 >>lpNumberOfBytesSent + (make-overlapped) >>lpOverlapped ; inline + +: call-WSASendTo ( WSASendTo -- ) + { + [ s>> ] + [ lpBuffers>> ] + [ dwBufferCount>> ] + [ lpNumberOfBytesSent>> ] + [ dwFlags>> ] + [ lpTo>> ] + [ iToLen>> ] + [ lpOverlapped>> ] + [ lpCompletionRoutine>> ] + } cleave WSASendTo socket-error* ; inline + +M: winnt (send) ( packet addrspec datagram -- ) + [ + + [ call-WSASendTo ] + [ wait-for-socket drop ] + bi + ] with-destructors ; diff --git a/basis/system-info/windows/ce/ce.factor b/basis/system-info/windows/ce/ce.factor deleted file mode 100644 index 8c4f81a117..0000000000 --- a/basis/system-info/windows/ce/ce.factor +++ /dev/null @@ -1,33 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types alien.data system-info kernel math namespaces -windows windows.kernel32 system-info.backend system ; -IN: system-info.windows.ce - -: memory-status ( -- MEMORYSTATUS ) - "MEMORYSTATUS" - "MEMORYSTATUS" heap-size over set-MEMORYSTATUS-dwLength - dup GlobalMemoryStatus ; - -M: wince cpus ( -- n ) 1 ; - -M: wince memory-load ( -- n ) - memory-status MEMORYSTATUS-dwMemoryLoad ; - -M: wince physical-mem ( -- n ) - memory-status MEMORYSTATUS-dwTotalPhys ; - -M: wince available-mem ( -- n ) - memory-status MEMORYSTATUS-dwAvailPhys ; - -M: wince total-page-file ( -- n ) - memory-status MEMORYSTATUS-dwTotalPageFile ; - -M: wince available-page-file ( -- n ) - memory-status MEMORYSTATUS-dwAvailPageFile ; - -M: wince total-virtual-mem ( -- n ) - memory-status MEMORYSTATUS-dwTotalVirtual ; - -M: wince available-virtual-mem ( -- n ) - memory-status MEMORYSTATUS-dwAvailVirtual ; diff --git a/basis/system-info/windows/ce/platforms.txt b/basis/system-info/windows/ce/platforms.txt deleted file mode 100644 index cd0d980f6f..0000000000 --- a/basis/system-info/windows/ce/platforms.txt +++ /dev/null @@ -1 +0,0 @@ -wince diff --git a/basis/system-info/windows/nt/authors.txt b/basis/system-info/windows/nt/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/basis/system-info/windows/nt/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/basis/system-info/windows/nt/nt.factor b/basis/system-info/windows/nt/nt.factor deleted file mode 100644 index 804eb25def..0000000000 --- a/basis/system-info/windows/nt/nt.factor +++ /dev/null @@ -1,47 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings -kernel libc math namespaces system-info.backend -system-info.windows windows windows.advapi32 -windows.kernel32 system byte-arrays windows.errors -classes classes.struct accessors ; -IN: system-info.windows.nt - -M: winnt cpus ( -- n ) - system-info dwNumberOfProcessors>> ; - -: memory-status ( -- MEMORYSTATUSEX ) - MEMORYSTATUSEX - MEMORYSTATUSEX heap-size >>dwLength - dup GlobalMemoryStatusEx win32-error=0/f ; - -M: winnt memory-load ( -- n ) - memory-status dwMemoryLoad>> ; - -M: winnt physical-mem ( -- n ) - memory-status ullTotalPhys>> ; - -M: winnt available-mem ( -- n ) - memory-status ullAvailPhys>> ; - -M: winnt total-page-file ( -- n ) - memory-status ullTotalPageFile>> ; - -M: winnt available-page-file ( -- n ) - memory-status ullAvailPageFile>> ; - -M: winnt total-virtual-mem ( -- n ) - memory-status ullTotalVirtual>> ; - -M: winnt available-virtual-mem ( -- n ) - memory-status ullAvailVirtual>> ; - -: computer-name ( -- string ) - MAX_COMPUTERNAME_LENGTH 1 + - [ dup ] keep - GetComputerName win32-error=0/f alien>native-string ; - -: username ( -- string ) - UNLEN 1 + - [ dup ] keep - GetUserName win32-error=0/f alien>native-string ; diff --git a/basis/system-info/windows/nt/platforms.txt b/basis/system-info/windows/nt/platforms.txt deleted file mode 100644 index 205e64323d..0000000000 --- a/basis/system-info/windows/nt/platforms.txt +++ /dev/null @@ -1 +0,0 @@ -winnt diff --git a/basis/system-info/windows/nt/nt-tests.factor b/basis/system-info/windows/windows-tests.factor old mode 100755 new mode 100644 similarity index 58% rename from basis/system-info/windows/nt/nt-tests.factor rename to basis/system-info/windows/windows-tests.factor index dfbd8b3283..d26e86742c --- a/basis/system-info/windows/nt/nt-tests.factor +++ b/basis/system-info/windows/windows-tests.factor @@ -1,7 +1,6 @@ USING: math.order strings system-info.backend -system-info.windows system-info.windows.nt -tools.test ; -IN: system-info.windows.nt.tests +system-info.windows tools.test ; +IN: system-info.windows.tests [ t ] [ cpus 0 1024 between? ] unit-test [ t ] [ username string? ] unit-test diff --git a/basis/system-info/windows/windows.factor b/basis/system-info/windows/windows.factor index 07cbcc41b3..0aba5eeff1 100644 --- a/basis/system-info/windows/windows.factor +++ b/basis/system-info/windows/windows.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types classes.struct accessors kernel -math namespaces windows windows.kernel32 windows.advapi32 words -combinators vocabs.loader system-info.backend system -alien.strings windows.errors specialized-arrays ; +USING: accessors alien alien.c-types alien.strings byte-arrays +classes.struct combinators kernel math namespaces +specialized-arrays system +system-info.backend vocabs.loader windows windows.advapi32 +windows.errors windows.kernel32 words ; SPECIALIZED-ARRAY: ushort IN: system-info.windows @@ -63,8 +64,41 @@ IN: system-info.windows : system-windows-directory ( -- str ) \ GetSystemWindowsDirectory get-directory ; -<< -{ - { [ os wince? ] [ "system-info.windows.ce" ] } - { [ os winnt? ] [ "system-info.windows.nt" ] } -} cond require >> +M: winnt cpus ( -- n ) + system-info dwNumberOfProcessors>> ; + +: memory-status ( -- MEMORYSTATUSEX ) + MEMORYSTATUSEX + MEMORYSTATUSEX heap-size >>dwLength + dup GlobalMemoryStatusEx win32-error=0/f ; + +M: winnt memory-load ( -- n ) + memory-status dwMemoryLoad>> ; + +M: winnt physical-mem ( -- n ) + memory-status ullTotalPhys>> ; + +M: winnt available-mem ( -- n ) + memory-status ullAvailPhys>> ; + +M: winnt total-page-file ( -- n ) + memory-status ullTotalPageFile>> ; + +M: winnt available-page-file ( -- n ) + memory-status ullAvailPageFile>> ; + +M: winnt total-virtual-mem ( -- n ) + memory-status ullTotalVirtual>> ; + +M: winnt available-virtual-mem ( -- n ) + memory-status ullAvailVirtual>> ; + +: computer-name ( -- string ) + MAX_COMPUTERNAME_LENGTH 1 + + [ dup ] keep + GetComputerName win32-error=0/f alien>native-string ; + +: username ( -- string ) + UNLEN 1 + + [ dup ] keep + GetUserName win32-error=0/f alien>native-string ; diff --git a/basis/tools/deploy/windows/windows.factor b/basis/tools/deploy/windows/windows.factor index 7981859573..7fad2414fc 100755 --- a/basis/tools/deploy/windows/windows.factor +++ b/basis/tools/deploy/windows/windows.factor @@ -6,7 +6,7 @@ sequences locals system splitting tools.deploy.backend tools.deploy.config tools.deploy.config.editor assocs hashtables prettyprint combinators windows.kernel32 windows.shell32 windows.user32 alien.c-types vocabs.metadata vocabs.loader tools.deploy.windows.ico -io.files.windows.nt ; +io.files.windows ; IN: tools.deploy.windows CONSTANT: app-icon-resource-id "APPICON" diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index be184329a3..5178dbb499 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -7,7 +7,7 @@ ui.clipboards ui.gadgets.worlds ui.gestures ui.event-loop io kernel math math.vectors namespaces make sequences strings vectors words windows.dwmapi system-info.windows windows.kernel32 windows.gdi32 windows.user32 windows.opengl32 windows.messages -windows.types windows.offscreen windows.nt threads libc combinators +windows.types windows.offscreen windows threads libc combinators fry combinators.short-circuit continuations command-line shuffle opengl ui.render math.bitwise locals accessors math.rectangles math.order calendar ascii sets io.encodings.utf16n diff --git a/basis/windows/ce/authors.txt b/basis/windows/ce/authors.txt deleted file mode 100644 index 7c1b2f2279..0000000000 --- a/basis/windows/ce/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/basis/windows/ce/ce.factor b/basis/windows/ce/ce.factor deleted file mode 100644 index 614a535ea0..0000000000 --- a/basis/windows/ce/ce.factor +++ /dev/null @@ -1,14 +0,0 @@ -USING: alien sequences alien.libraries ; -{ - { "advapi32" "\\windows\\coredll.dll" stdcall } - { "gdi32" "\\windows\\coredll.dll" stdcall } - { "user32" "\\windows\\coredll.dll" stdcall } - { "kernel32" "\\windows\\coredll.dll" stdcall } - { "winsock" "\\windows\\ws2.dll" stdcall } - { "mswsock" "\\windows\\ws2.dll" stdcall } - { "libc" "\\windows\\coredll.dll" stdcall } - { "libm" "\\windows\\coredll.dll" stdcall } - ! { "gl" "libGLES_CM.dll" stdcall } - ! { "glu" "libGLES_CM.dll" stdcall } - { "ole32" "ole32.dll" stdcall } -} [ first3 add-library ] each diff --git a/basis/windows/ce/platforms.txt b/basis/windows/ce/platforms.txt deleted file mode 100644 index cd0d980f6f..0000000000 --- a/basis/windows/ce/platforms.txt +++ /dev/null @@ -1 +0,0 @@ -wince diff --git a/basis/windows/nt/authors.txt b/basis/windows/nt/authors.txt deleted file mode 100644 index 7c1b2f2279..0000000000 --- a/basis/windows/nt/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/basis/windows/nt/nt.factor b/basis/windows/nt/nt.factor deleted file mode 100644 index 4b119ba5fa..0000000000 --- a/basis/windows/nt/nt.factor +++ /dev/null @@ -1,35 +0,0 @@ -USING: alien sequences alien.libraries ; -{ - { "advapi32" "advapi32.dll" stdcall } - { "dinput" "dinput8.dll" stdcall } - { "gdi32" "gdi32.dll" stdcall } - { "user32" "user32.dll" stdcall } - { "kernel32" "kernel32.dll" stdcall } - { "winsock" "ws2_32.dll" stdcall } - { "mswsock" "mswsock.dll" stdcall } - { "shell32" "shell32.dll" stdcall } - { "libc" "msvcrt.dll" cdecl } - { "libm" "msvcrt.dll" cdecl } - { "gl" "opengl32.dll" stdcall } - { "glu" "glu32.dll" stdcall } - { "ole32" "ole32.dll" stdcall } - { "usp10" "usp10.dll" stdcall } - { "psapi" "psapi.dll" stdcall } - { "xinput" "xinput1_3.dll" stdcall } - { "dxgi" "dxgi.dll" stdcall } - { "d2d1" "d2d1.dll" stdcall } - { "d3d9" "d3d9.dll" stdcall } - { "d3d10" "d3d10.dll" stdcall } - { "d3d10_1" "d3d10_1.dll" stdcall } - { "d3d11" "d3d11.dll" stdcall } - { "d3dcompiler" "d3dcompiler_42.dll" stdcall } - { "d3dcsx" "d3dcsx_42.dll" stdcall } - { "d3dx9" "d3dx9_42.dll" stdcall } - { "d3dx10" "d3dx10_42.dll" stdcall } - { "d3dx11" "d3dx11_42.dll" stdcall } - { "dwrite" "dwrite.dll" stdcall } - { "x3daudio" "x3daudio1_6.dll" stdcall } - { "xactengine" "xactengine3_5.dll" stdcall } - { "xapofx" "xapofx1_3.dll" stdcall } - { "xaudio2" "xaudio2_5.dll" stdcall } -} [ first3 add-library ] each diff --git a/basis/windows/nt/platforms.txt b/basis/windows/nt/platforms.txt deleted file mode 100644 index 205e64323d..0000000000 --- a/basis/windows/nt/platforms.txt +++ /dev/null @@ -1 +0,0 @@ -winnt diff --git a/basis/system-info/windows/ce/authors.txt b/basis/windows/privileges/authors.txt old mode 100755 new mode 100644 similarity index 100% rename from basis/system-info/windows/ce/authors.txt rename to basis/windows/privileges/authors.txt diff --git a/basis/io/backend/windows/privileges/platforms.txt b/basis/windows/privileges/platforms.txt similarity index 100% rename from basis/io/backend/windows/privileges/platforms.txt rename to basis/windows/privileges/platforms.txt diff --git a/basis/windows/privileges/privileges-tests.factor b/basis/windows/privileges/privileges-tests.factor new file mode 100644 index 0000000000..355ed71614 --- /dev/null +++ b/basis/windows/privileges/privileges-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2010 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test windows.privileges ; +IN: windows.privileges.tests diff --git a/basis/io/backend/windows/nt/privileges/privileges.factor b/basis/windows/privileges/privileges.factor similarity index 70% rename from basis/io/backend/windows/nt/privileges/privileges.factor rename to basis/windows/privileges/privileges.factor index 896785b048..ed2827ed8a 100644 --- a/basis/io/backend/windows/nt/privileges/privileges.factor +++ b/basis/windows/privileges/privileges.factor @@ -1,11 +1,9 @@ -USING: alien alien.c-types alien.data alien.syntax arrays -continuations destructors generic io.mmap io.ports -io.backend.windows io.files.windows kernel libc fry locals math -math.bitwise namespaces quotations sequences windows -windows.advapi32 windows.kernel32 windows.types io.backend -system accessors io.backend.windows.privileges classes.struct -windows.errors literals ; -IN: io.backend.windows.nt.privileges +! Copyright (C) 2010 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien alien.data alien.syntax classes.struct +continuations fry kernel libc literals locals sequences +windows.advapi32 windows.errors windows.kernel32 windows.types ; +IN: windows.privileges TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES @@ -40,7 +38,7 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES name lookup-privilege >>Luid >>Privileges ; -M: winnt set-privilege ( name ? -- ) +: set-privilege ( name ? -- ) '[ 0 _ _ make-token-privileges @@ -49,3 +47,8 @@ M: winnt set-privilege ( name ? -- ) f AdjustTokenPrivileges win32-error=0/f ] with-process-token ; + +: with-privileges ( seq quot -- ) + [ '[ _ [ t set-privilege ] each @ ] ] + [ drop '[ _ [ f set-privilege ] each ] ] + 2bi [ ] cleanup ; inline diff --git a/basis/windows/windows.factor b/basis/windows/windows.factor index 92ba8b638a..dcdcb8b227 100644 --- a/basis/windows/windows.factor +++ b/basis/windows/windows.factor @@ -1,5 +1,41 @@ ! Copyright (C) 2005, 2006 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. +USING: alien sequences alien.libraries ; IN: windows CONSTANT: MAX_UNICODE_PATH 32768 + +{ + { "advapi32" "advapi32.dll" stdcall } + { "dinput" "dinput8.dll" stdcall } + { "gdi32" "gdi32.dll" stdcall } + { "user32" "user32.dll" stdcall } + { "kernel32" "kernel32.dll" stdcall } + { "winsock" "ws2_32.dll" stdcall } + { "mswsock" "mswsock.dll" stdcall } + { "shell32" "shell32.dll" stdcall } + { "libc" "msvcrt.dll" cdecl } + { "libm" "msvcrt.dll" cdecl } + { "gl" "opengl32.dll" stdcall } + { "glu" "glu32.dll" stdcall } + { "ole32" "ole32.dll" stdcall } + { "usp10" "usp10.dll" stdcall } + { "psapi" "psapi.dll" stdcall } + { "xinput" "xinput1_3.dll" stdcall } + { "dxgi" "dxgi.dll" stdcall } + { "d2d1" "d2d1.dll" stdcall } + { "d3d9" "d3d9.dll" stdcall } + { "d3d10" "d3d10.dll" stdcall } + { "d3d10_1" "d3d10_1.dll" stdcall } + { "d3d11" "d3d11.dll" stdcall } + { "d3dcompiler" "d3dcompiler_42.dll" stdcall } + { "d3dcsx" "d3dcsx_42.dll" stdcall } + { "d3dx9" "d3dx9_42.dll" stdcall } + { "d3dx10" "d3dx10_42.dll" stdcall } + { "d3dx11" "d3dx11_42.dll" stdcall } + { "dwrite" "dwrite.dll" stdcall } + { "x3daudio" "x3daudio1_6.dll" stdcall } + { "xactengine" "xactengine3_5.dll" stdcall } + { "xapofx" "xapofx1_3.dll" stdcall } + { "xaudio2" "xaudio2_5.dll" stdcall } +} [ first3 add-library ] each diff --git a/unmaintained/ce/authors.txt b/unmaintained/ce/authors.txt deleted file mode 100644 index 7c1b2f2279..0000000000 --- a/unmaintained/ce/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/unmaintained/ce/backend/authors.txt b/unmaintained/ce/backend/authors.txt deleted file mode 100755 index 026f4cd0de..0000000000 --- a/unmaintained/ce/backend/authors.txt +++ /dev/null @@ -1,3 +0,0 @@ -Doug Coleman -Slava Pestov -Mackenzie Straight diff --git a/unmaintained/ce/backend/backend.factor b/unmaintained/ce/backend/backend.factor deleted file mode 100644 index 7209a68ebf..0000000000 --- a/unmaintained/ce/backend/backend.factor +++ /dev/null @@ -1,50 +0,0 @@ -USING: io.ports io.windows threads.private kernel -io.backend windows.winsock windows.kernel32 windows -io.streams.duplex io namespaces alien.syntax system combinators -io.buffers io.encodings io.encodings.utf8 combinators.lib ; -IN: io.windows.ce.backend - -: port-errored ( port -- ) - win32-error-string swap set-port-error ; - -M: wince io-multiplex ( ms -- ) - 60 60 * 1000 * or (sleep) ; - -M: wince add-completion ( handle -- ) drop ; - -GENERIC: wince-read ( port port-handle -- ) - -M: input-port (wait-to-read) ( port -- ) - dup dup port-handle wince-read pending-error ; - -GENERIC: wince-write ( port port-handle -- ) - -M: port port-flush - dup buffer-empty? over port-error or [ - drop - ] [ - dup dup port-handle wince-write port-flush - ] if ; - -M: wince init-io ( -- ) - init-winsock ; - -LIBRARY: libc -FUNCTION: void* _getstdfilex int fd ; -FUNCTION: void* _fileno void* file ; - -M: wince (init-stdio) ( -- ) - #! We support Windows NT too, to make this I/O backend - #! easier to debug. - 512 default-buffer-size [ - os winnt? [ - STD_INPUT_HANDLE GetStdHandle - STD_OUTPUT_HANDLE GetStdHandle - STD_ERROR_HANDLE GetStdHandle - ] [ - 0 _getstdfilex _fileno - 1 _getstdfilex _fileno - 2 _getstdfilex _fileno - ] if [ f ] 3apply - [ ] [ ] [ ] tri* - ] with-variable ; diff --git a/unmaintained/ce/ce.factor b/unmaintained/ce/ce.factor deleted file mode 100644 index a0a8de8513..0000000000 --- a/unmaintained/ce/ce.factor +++ /dev/null @@ -1,11 +0,0 @@ -USE: io.backend -USE: io.windows -USE: io.windows.ce.backend -USE: io.windows.ce.files -USE: io.windows.ce.sockets -USE: io.windows.ce.launcher -USE: io.windows.mmap system -USE: io.windows.files -USE: system - -wince set-io-backend diff --git a/unmaintained/ce/files/authors.txt b/unmaintained/ce/files/authors.txt deleted file mode 100755 index 5674120196..0000000000 --- a/unmaintained/ce/files/authors.txt +++ /dev/null @@ -1,2 +0,0 @@ -Doug Coleman -Slava Pestov diff --git a/unmaintained/ce/files/files.factor b/unmaintained/ce/files/files.factor deleted file mode 100644 index 83d456832b..0000000000 --- a/unmaintained/ce/files/files.factor +++ /dev/null @@ -1,32 +0,0 @@ -USING: alien alien.c-types combinators io io.backend io.buffers -io.files io.ports io.windows kernel libc math namespaces -prettyprint sequences strings threads threads.private -windows windows.kernel32 io.windows.ce.backend system ; -IN: windows.ce.files - -! M: wince normalize-path ( string -- string ) - ! dup 1 tail* CHAR: \\ = [ "*" append ] [ "\\*" append ] if ; - -M: wince CreateFile-flags ( DWORD -- DWORD ) - FILE_ATTRIBUTE_NORMAL bitor ; -M: wince FileArgs-overlapped ( port -- f ) drop f ; - -: finish-read ( port status bytes-ret -- ) - swap [ drop port-errored ] [ swap n>buffer ] if ; - -M: win32-file wince-read - drop - dup make-FileArgs dup setup-read ReadFile zero? - swap FileArgs-lpNumberOfBytesRet *uint dup zero? [ - 2drop t swap set-port-eof? - ] [ - finish-read - ] if ; - -M: win32-file wince-write ( port port-handle -- ) - drop dup make-FileArgs dup setup-write WriteFile zero? [ - drop port-errored - ] [ - FileArgs-lpNumberOfBytesRet *uint - swap buffer-consume - ] if ; diff --git a/unmaintained/ce/privileges/privileges.factor b/unmaintained/ce/privileges/privileges.factor deleted file mode 100644 index e0aa186b3d..0000000000 --- a/unmaintained/ce/privileges/privileges.factor +++ /dev/null @@ -1,4 +0,0 @@ -IN: io.windows.ce.privileges -USING: io.windows.privileges system ; - -M: wince set-privilege 2drop ; diff --git a/unmaintained/ce/sockets/authors.txt b/unmaintained/ce/sockets/authors.txt deleted file mode 100755 index 5674120196..0000000000 --- a/unmaintained/ce/sockets/authors.txt +++ /dev/null @@ -1,2 +0,0 @@ -Doug Coleman -Slava Pestov diff --git a/unmaintained/ce/sockets/sockets.factor b/unmaintained/ce/sockets/sockets.factor deleted file mode 100644 index b3117dcde1..0000000000 --- a/unmaintained/ce/sockets/sockets.factor +++ /dev/null @@ -1,113 +0,0 @@ -USING: alien alien.c-types combinators io io.backend io.buffers -io.ports io.sockets io.windows kernel libc -math namespaces prettyprint qualified sequences strings threads -threads.private windows windows.kernel32 io.windows.ce.backend -byte-arrays system ; -QUALIFIED: windows.winsock -IN: io.windows.ce - -M: wince WSASocket-flags ( -- DWORD ) 0 ; - -M: win32-socket wince-read ( port port-handle -- ) - win32-file-handle over buffer-end pick buffer-capacity 0 - windows.winsock:recv - dup windows.winsock:SOCKET_ERROR = [ - drop port-errored - ] [ - dup zero? - [ drop t swap set-port-eof? ] [ swap n>buffer ] if - ] if ; - -M: win32-socket wince-write ( port port-handle -- ) - win32-file-handle over buffer@ pick buffer-length 0 - windows.winsock:send - dup windows.winsock:SOCKET_ERROR = - [ drop port-errored ] [ swap buffer-consume ] if ; - -: do-connect ( addrspec -- socket ) - [ tcp-socket dup ] keep - make-sockaddr/size - f f f f - windows.winsock:WSAConnect - windows.winsock:winsock-error!=0/f ; - -M: wince (client) ( addrspec -- reader writer ) - do-connect dup ; - -M: wince (server) ( addrspec -- handle ) - windows.winsock:SOCK_STREAM server-fd - dup listen-on-socket - ; - -M: wince (accept) ( server -- client ) - [ - [ - dup port-handle win32-file-handle - swap server-port-addr sockaddr-type heap-size - dup [ - swap f 0 - windows.winsock:WSAAccept - dup windows.winsock:INVALID_SOCKET = - [ windows.winsock:winsock-error ] when - ] keep - ] keep server-port-addr parse-sockaddr swap - - ] with-timeout ; - -M: wince ( addrspec -- datagram ) - [ - windows.winsock:SOCK_DGRAM server-fd - ] keep ; - -: packet-size 65536 ; inline - -: receive-buffer ( -- buf ) - \ receive-buffer get-global expired? [ - packet-size malloc \ receive-buffer set-global - ] when - \ receive-buffer get-global ; - -: make-WSABUF ( len buf -- ptr ) - "WSABUF" - [ windows.winsock:set-WSABUF-buf ] keep - [ windows.winsock:set-WSABUF-len ] keep ; - -: receive-WSABUF ( -- buf ) - packet-size receive-buffer make-WSABUF ; - -: packet-data ( len -- byte-array ) - receive-buffer swap memory>byte-array ; - -packet-size receive-buffer set-global - -M: wince receive ( datagram -- packet addrspec ) - dup check-datagram-port - [ - port-handle win32-file-handle - receive-WSABUF - 1 - 0 [ - 0 - 64 "char" [ - 64 - f - f - windows.winsock:WSARecvFrom - windows.winsock:winsock-error!=0/f - ] keep - ] keep *uint packet-data swap - ] keep datagram-port-addr parse-sockaddr ; - -: send-WSABUF ( byte-array -- ptr ) - dup length packet-size > [ "UDP packet too long" throw ] when - dup length receive-buffer rot pick memcpy - receive-buffer make-WSABUF ; - -M: wince send ( packet addrspec datagram -- ) - 3dup check-datagram-send - port-handle win32-file-handle - rot send-WSABUF - rot make-sockaddr/size - >r >r 1 0 0 r> r> f f - windows.winsock:WSASendTo - windows.winsock:winsock-error!=0/f ; diff --git a/unmaintained/ce/summary.txt b/unmaintained/ce/summary.txt deleted file mode 100644 index 0c660f75a5..0000000000 --- a/unmaintained/ce/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Microsoft Windows CE native I/O implementation diff --git a/vm/Config.windows b/vm/Config.windows index 11df403541..1886ee77d6 100644 --- a/vm/Config.windows +++ b/vm/Config.windows @@ -1,10 +1,17 @@ -CFLAGS += -mno-cygwin -LIBS = -lm -PLAF_DLL_OBJS += vm/os-windows.o +CFLAGS += -mno-cygwin -mwindows +CFLAGS_CONSOLE += -mconsole SHARED_FLAG = -shared +SHARED_DLL_EXTENSION=.dll + +LIBS = -lm + +PLAF_EXE_OBJS += vm/resources.o vm/main-windows.o + +EXE_SUFFIX= EXE_EXTENSION=.exe -CONSOLE_EXTENSION=.com +DLL_SUFFIX= DLL_EXTENSION=.dll -SHARED_DLL_EXTENSION=.dll +CONSOLE_EXTENSION=.com + LINKER = $(CPP) -shared -mno-cygwin -o LINK_WITH_ENGINE = -l$(DLL_PREFIX)factor$(DLL_SUFFIX) diff --git a/vm/Config.windows.ce b/vm/Config.windows.ce deleted file mode 100644 index 2e3204a589..0000000000 --- a/vm/Config.windows.ce +++ /dev/null @@ -1,5 +0,0 @@ -CFLAGS += -DWINCE -LIBS = -lm -PLAF_DLL_OBJS += vm/os-windows-ce.o -PLAF_EXE_OBJS += vm/main-windows-ce.o -include vm/Config.windows diff --git a/vm/Config.windows.ce.arm b/vm/Config.windows.ce.arm deleted file mode 100644 index 98e08e8f61..0000000000 --- a/vm/Config.windows.ce.arm +++ /dev/null @@ -1,4 +0,0 @@ -CC = arm-wince-mingw32ce-gcc -DLL_SUFFIX=-ce -EXE_SUFFIX=-ce -include vm/Config.windows.ce vm/Config.arm diff --git a/vm/Config.windows.nt b/vm/Config.windows.nt deleted file mode 100644 index 322649dc06..0000000000 --- a/vm/Config.windows.nt +++ /dev/null @@ -1,10 +0,0 @@ -LIBS = -lm -EXE_SUFFIX= -DLL_SUFFIX= -PLAF_DLL_OBJS += vm/os-windows-nt.o vm/mvm-windows-nt.o -PLAF_EXE_OBJS += vm/resources.o -PLAF_EXE_OBJS += vm/main-windows-nt.o -CFLAGS += -mwindows -CFLAGS_CONSOLE += -mconsole -CONSOLE_EXTENSION = .com -include vm/Config.windows diff --git a/vm/Config.windows.nt.x86.32 b/vm/Config.windows.x86.32 similarity index 51% rename from vm/Config.windows.nt.x86.32 rename to vm/Config.windows.x86.32 index 73bf064ce5..6ba2955d79 100644 --- a/vm/Config.windows.nt.x86.32 +++ b/vm/Config.windows.x86.32 @@ -1,5 +1,5 @@ -PLAF_DLL_OBJS += vm/os-windows-nt-x86.32.o +PLAF_DLL_OBJS += vm/os-windows-x86.32.o DLL_PATH=http://factorcode.org/dlls WINDRES=windres -include vm/Config.windows.nt +include vm/Config.windows include vm/Config.x86.32 diff --git a/vm/Config.windows.nt.x86.64 b/vm/Config.windows.x86.64 similarity index 63% rename from vm/Config.windows.nt.x86.64 rename to vm/Config.windows.x86.64 index 495a3ccac9..f3dc9b0b77 100644 --- a/vm/Config.windows.nt.x86.64 +++ b/vm/Config.windows.x86.64 @@ -1,6 +1,6 @@ -PLAF_DLL_OBJS += vm/os-windows-nt-x86.64.o +PLAF_DLL_OBJS += vm/os-windows-x86.64.o DLL_PATH=http://factorcode.org/dlls/64 CC=$(WIN64_PATH)-gcc.exe WINDRES=$(WIN64_PATH)-windres.exe -include vm/Config.windows.nt +include vm/Config.windows include vm/Config.x86.64 diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index b42261619b..b67da28922 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -13,7 +13,7 @@ code_heap::code_heap(cell size) allocator = new free_list_allocator(seg->end - start,start); - /* See os-windows-nt-x86.64.cpp for seh_area usage */ + /* See os-windows-x86.64.cpp for seh_area usage */ seh_area = (char *)seg->start; } diff --git a/vm/main-windows-ce.cpp b/vm/main-windows-ce.cpp deleted file mode 100755 index ed5844167a..0000000000 --- a/vm/main-windows-ce.cpp +++ /dev/null @@ -1,132 +0,0 @@ -#include "master.hpp" - -/* - Windows argument parsing ported to work on - int main(int argc, wchar_t **argv). - - Based on MinGW's public domain char** version. -*/ - -VM_C_API int parse_tokens(wchar_t *string, wchar_t ***tokens, int length) -{ - /* Extract whitespace- and quotes- delimited tokens from the given string - and put them into the tokens array. Returns number of tokens - extracted. Length specifies the current size of tokens[]. - THIS METHOD MODIFIES string. */ - - const wchar_t *whitespace = L" \t\r\n"; - wchar_t *tokenEnd = 0; - const wchar_t *quoteCharacters = L"\"\'"; - wchar_t *end = string + wcslen(string); - - if (string == NULL) - return length; - - while (1) - { - const wchar_t *q; - /* Skip over initial whitespace. */ - string += wcsspn(string, whitespace); - if (*string == '\0') - break; - - for (q = quoteCharacters; *q; ++q) - { - if (*string == *q) - break; - } - if (*q) - { - /* Token is quoted. */ - wchar_t quote = *string++; - tokenEnd = wcschr(string, quote); - /* If there is no endquote, the token is the rest of the string. */ - if (!tokenEnd) - tokenEnd = end; - } - else - { - tokenEnd = string + wcscspn(string, whitespace); - } - - *tokenEnd = '\0'; - - { - wchar_t **new_tokens; - int newlen = length + 1; - new_tokens = (wchar_t **)realloc (*tokens, sizeof (wchar_t**) * newlen); - if (!new_tokens) - { - /* Out of memory. */ - return -1; - } - - *tokens = new_tokens; - (*tokens)[length] = string; - length = newlen; - } - if (tokenEnd == end) - break; - string = tokenEnd + 1; - } - return length; -} - -VM_C_API void parse_args(int *argc, wchar_t ***argv, wchar_t *cmdlinePtrW) -{ - int cmdlineLen = 0; - - if (!cmdlinePtrW) - cmdlineLen = 0; - else - cmdlineLen = wcslen(cmdlinePtrW); - - /* gets realloc()'d later */ - *argc = 0; - *argv = (wchar_t **)malloc (sizeof (wchar_t**)); - - if (!*argv) - ExitProcess(1); - -#ifdef WINCE - wchar_t cmdnameBufW[MAX_UNICODE_PATH]; - - /* argv[0] is the path of invoked program - get this from CE. */ - cmdnameBufW[0] = 0; - GetModuleFileNameW(NULL, cmdnameBufW, sizeof (cmdnameBufW)/sizeof (cmdnameBufW[0])); - - (*argv)[0] = wcsdup(cmdnameBufW); - if(!(*argv[0])) - ExitProcess(1); - /* Add one to account for argv[0] */ - (*argc)++; -#endif - - if (cmdlineLen > 0) - { - wchar_t *string = wcsdup(cmdlinePtrW); - if(!string) - ExitProcess(1); - *argc = parse_tokens(string, argv, *argc); - if (*argc < 0) - ExitProcess(1); - } - (*argv)[*argc] = 0; - return; -} - -int WINAPI WinMain( - HINSTANCE hInstance, - HINSTANCE hPrevInstance, - LPWSTR lpCmdLine, - int nCmdShow) -{ - int __argc; - wchar_t **__argv; - factor::parse_args(&__argc, &__argv, lpCmdLine); - factor::init_globals(); - factor::start_standalone_factor(__argc,(LPWSTR*)__argv); - - // memory leak from malloc, wcsdup - return 0; -} diff --git a/vm/main-windows-nt.cpp b/vm/main-windows.cpp old mode 100755 new mode 100644 similarity index 100% rename from vm/main-windows-nt.cpp rename to vm/main-windows.cpp diff --git a/vm/mvm-windows-nt.cpp b/vm/mvm-windows.cpp similarity index 100% rename from vm/mvm-windows-nt.cpp rename to vm/mvm-windows.cpp diff --git a/vm/os-windows-ce.cpp b/vm/os-windows-ce.cpp deleted file mode 100644 index 65e8ef5b09..0000000000 --- a/vm/os-windows-ce.cpp +++ /dev/null @@ -1,30 +0,0 @@ -#include "master.hpp" - -namespace factor -{ - -char *strerror(int err) -{ - /* strerror() is not defined on WinCE */ - return "strerror() is not defined on WinCE. Use native I/O."; -} - -void flush_icache(cell start, cell end) -{ - FlushInstructionCache(GetCurrentProcess(), 0, 0); -} - -char *getenv(char *name) -{ - vm->not_implemented_error(); - return 0; /* unreachable */ -} - -void c_to_factor_toplevel(cell quot) -{ - c_to_factor(quot,vm); -} - -void open_console() { } - -} diff --git a/vm/os-windows-ce.hpp b/vm/os-windows-ce.hpp deleted file mode 100755 index 892fc88be9..0000000000 --- a/vm/os-windows-ce.hpp +++ /dev/null @@ -1,27 +0,0 @@ -#ifndef UNICODE -#define UNICODE -#endif - -#include -#include - -namespace factor -{ - -typedef wchar_t symbol_char; - -#define FACTOR_OS_STRING "wince" -#define FACTOR_DLL L"factor-ce.dll" - -int errno; -char *strerror(int err); -void flush_icache(cell start, cell end); -char *getenv(char *name); - -#define snprintf _snprintf -#define snwprintf _snwprintf - -void c_to_factor_toplevel(cell quot); -void open_console(); - -} diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp deleted file mode 100755 index 395ab10214..0000000000 --- a/vm/os-windows-nt.cpp +++ /dev/null @@ -1,100 +0,0 @@ -#include "master.hpp" - -namespace factor -{ - -THREADHANDLE start_thread(void *(*start_routine)(void *), void *args) -{ - return (void *)CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)start_routine, args, 0, 0); -} - -u64 nano_count() -{ - static double scale_factor; - - static u32 hi = 0; - static u32 lo = 0; - - LARGE_INTEGER count; - BOOL ret = QueryPerformanceCounter(&count); - if(ret == 0) - fatal_error("QueryPerformanceCounter", 0); - - if(scale_factor == 0.0) - { - LARGE_INTEGER frequency; - BOOL ret = QueryPerformanceFrequency(&frequency); - if(ret == 0) - fatal_error("QueryPerformanceFrequency", 0); - scale_factor = (1000000000.0 / frequency.QuadPart); - } - -#ifdef FACTOR_64 - hi = count.HighPart; -#else - /* On VirtualBox, QueryPerformanceCounter does not increment - the high part every time the low part overflows. Workaround. */ - if(lo > count.LowPart) - hi++; -#endif - lo = count.LowPart; - - return (u64)((((u64)hi << 32) | (u64)lo) * scale_factor); -} - -void sleep_nanos(u64 nsec) -{ - Sleep((DWORD)(nsec/1000000)); -} - -LONG factor_vm::exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, void *dispatch) -{ - c->ESP = (cell)fix_callstack_top((stack_frame *)c->ESP); - ctx->callstack_top = (stack_frame *)c->ESP; - - switch (e->ExceptionCode) - { - case EXCEPTION_ACCESS_VIOLATION: - signal_fault_addr = e->ExceptionInformation[1]; - c->EIP = (cell)factor::memory_signal_handler_impl; - break; - - case STATUS_FLOAT_DENORMAL_OPERAND: - case STATUS_FLOAT_DIVIDE_BY_ZERO: - case STATUS_FLOAT_INEXACT_RESULT: - case STATUS_FLOAT_INVALID_OPERATION: - case STATUS_FLOAT_OVERFLOW: - case STATUS_FLOAT_STACK_CHECK: - case STATUS_FLOAT_UNDERFLOW: - case STATUS_FLOAT_MULTIPLE_FAULTS: - case STATUS_FLOAT_MULTIPLE_TRAPS: -#ifdef FACTOR_64 - signal_fpu_status = fpu_status(MXCSR(c)); -#else - signal_fpu_status = fpu_status(X87SW(c) | MXCSR(c)); - - /* This seems to have no effect */ - X87SW(c) = 0; -#endif - MXCSR(c) &= 0xffffffc0; - c->EIP = (cell)factor::fp_signal_handler_impl; - break; - default: - signal_number = e->ExceptionCode; - c->EIP = (cell)factor::misc_signal_handler_impl; - break; - } - - return 0; -} - -VM_C_API LONG exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, void *dispatch) -{ - return current_vm()->exception_handler(e,frame,c,dispatch); -} - -void factor_vm::open_console() -{ -} - -} diff --git a/vm/os-windows-nt.hpp b/vm/os-windows-nt.hpp deleted file mode 100755 index 60990c0986..0000000000 --- a/vm/os-windows-nt.hpp +++ /dev/null @@ -1,42 +0,0 @@ -#undef _WIN32_WINNT -#define _WIN32_WINNT 0x0501 // For AddVectoredExceptionHandler - -#ifndef UNICODE -#define UNICODE -#endif - -#include -#include - -#ifdef _MSC_VER - #undef min - #undef max -#endif - -namespace factor -{ - -typedef char symbol_char; - -#define FACTOR_OS_STRING "winnt" - -#define FACTOR_DLL NULL - -VM_C_API LONG exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, void *dispatch); - -// SSE traps raise these exception codes, which are defined in internal NT headers -// but not winbase.h -#ifndef STATUS_FLOAT_MULTIPLE_FAULTS -#define STATUS_FLOAT_MULTIPLE_FAULTS 0xC00002B4 -#endif - -#ifndef STATUS_FLOAT_MULTIPLE_TRAPS -#define STATUS_FLOAT_MULTIPLE_TRAPS 0xC00002B5 -#endif - -typedef HANDLE THREADHANDLE; - -THREADHANDLE start_thread(void *(*start_routine)(void *),void *args); -inline static THREADHANDLE thread_id() { return GetCurrentThread(); } - -} diff --git a/vm/os-windows-nt-x86.32.cpp b/vm/os-windows-x86.32.cpp similarity index 100% rename from vm/os-windows-nt-x86.32.cpp rename to vm/os-windows-x86.32.cpp diff --git a/vm/os-windows-nt-x86.64.cpp b/vm/os-windows-x86.64.cpp similarity index 100% rename from vm/os-windows-nt-x86.64.cpp rename to vm/os-windows-x86.64.cpp diff --git a/vm/os-windows-nt.32.hpp b/vm/os-windows.32.hpp old mode 100755 new mode 100644 similarity index 100% rename from vm/os-windows-nt.32.hpp rename to vm/os-windows.32.hpp diff --git a/vm/os-windows-nt.64.hpp b/vm/os-windows.64.hpp old mode 100755 new mode 100644 similarity index 100% rename from vm/os-windows-nt.64.hpp rename to vm/os-windows.64.hpp diff --git a/vm/os-windows.cpp b/vm/os-windows.cpp index b9af2ec054..a54a5e15d7 100755 --- a/vm/os-windows.cpp +++ b/vm/os-windows.cpp @@ -151,4 +151,96 @@ void factor_vm::move_file(const vm_char *path1, const vm_char *path2) void factor_vm::init_signals() {} +THREADHANDLE start_thread(void *(*start_routine)(void *), void *args) +{ + return (void *)CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)start_routine, args, 0, 0); +} + +u64 nano_count() +{ + static double scale_factor; + + static u32 hi = 0; + static u32 lo = 0; + + LARGE_INTEGER count; + BOOL ret = QueryPerformanceCounter(&count); + if(ret == 0) + fatal_error("QueryPerformanceCounter", 0); + + if(scale_factor == 0.0) + { + LARGE_INTEGER frequency; + BOOL ret = QueryPerformanceFrequency(&frequency); + if(ret == 0) + fatal_error("QueryPerformanceFrequency", 0); + scale_factor = (1000000000.0 / frequency.QuadPart); + } + +#ifdef FACTOR_64 + hi = count.HighPart; +#else + /* On VirtualBox, QueryPerformanceCounter does not increment + the high part every time the low part overflows. Workaround. */ + if(lo > count.LowPart) + hi++; +#endif + lo = count.LowPart; + + return (u64)((((u64)hi << 32) | (u64)lo) * scale_factor); +} + +void sleep_nanos(u64 nsec) +{ + Sleep((DWORD)(nsec/1000000)); +} + +LONG factor_vm::exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, void *dispatch) +{ + c->ESP = (cell)fix_callstack_top((stack_frame *)c->ESP); + ctx->callstack_top = (stack_frame *)c->ESP; + + switch (e->ExceptionCode) + { + case EXCEPTION_ACCESS_VIOLATION: + signal_fault_addr = e->ExceptionInformation[1]; + c->EIP = (cell)factor::memory_signal_handler_impl; + break; + + case STATUS_FLOAT_DENORMAL_OPERAND: + case STATUS_FLOAT_DIVIDE_BY_ZERO: + case STATUS_FLOAT_INEXACT_RESULT: + case STATUS_FLOAT_INVALID_OPERATION: + case STATUS_FLOAT_OVERFLOW: + case STATUS_FLOAT_STACK_CHECK: + case STATUS_FLOAT_UNDERFLOW: + case STATUS_FLOAT_MULTIPLE_FAULTS: + case STATUS_FLOAT_MULTIPLE_TRAPS: +#ifdef FACTOR_64 + signal_fpu_status = fpu_status(MXCSR(c)); +#else + signal_fpu_status = fpu_status(X87SW(c) | MXCSR(c)); + + /* This seems to have no effect */ + X87SW(c) = 0; +#endif + MXCSR(c) &= 0xffffffc0; + c->EIP = (cell)factor::fp_signal_handler_impl; + break; + default: + signal_number = e->ExceptionCode; + c->EIP = (cell)factor::misc_signal_handler_impl; + break; + } + + return 0; +} + +VM_C_API LONG exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, void *dispatch) +{ + return current_vm()->exception_handler(e,frame,c,dispatch); +} + +void factor_vm::open_console() {} + } diff --git a/vm/os-windows.hpp b/vm/os-windows.hpp index 03dec4bb02..79f3e0d0aa 100755 --- a/vm/os-windows.hpp +++ b/vm/os-windows.hpp @@ -5,10 +5,30 @@ #include #endif +#undef _WIN32_WINNT +#define _WIN32_WINNT 0x0501 // For AddVectoredExceptionHandler + +#ifndef UNICODE +#define UNICODE +#endif + +#include +#include + +#ifdef _MSC_VER + #undef min + #undef max +#endif + +/* Difference between Jan 1 00:00:00 1601 and Jan 1 00:00:00 1970 */ +#define EPOCH_OFFSET 0x019db1ded53e8000LL + namespace factor { typedef wchar_t vm_char; +typedef char symbol_char; +typedef HANDLE THREADHANDLE; #define STRING_LITERAL(string) L##string @@ -29,17 +49,30 @@ typedef wchar_t vm_char; #define SNPRINTF snprintf #endif +#define FACTOR_OS_STRING "winnt" + +#define FACTOR_DLL NULL + +// SSE traps raise these exception codes, which are defined in internal NT headers +// but not winbase.h +#ifndef STATUS_FLOAT_MULTIPLE_FAULTS +#define STATUS_FLOAT_MULTIPLE_FAULTS 0xC00002B4 +#endif + +#ifndef STATUS_FLOAT_MULTIPLE_TRAPS +#define STATUS_FLOAT_MULTIPLE_TRAPS 0xC00002B5 +#endif + #define OPEN_READ(path) _wfopen((path),L"rb") #define OPEN_WRITE(path) _wfopen((path),L"wb") -/* Difference between Jan 1 00:00:00 1601 and Jan 1 00:00:00 1970 */ -#define EPOCH_OFFSET 0x019db1ded53e8000LL - inline static void early_init() {} - u64 nano_count(); void sleep_nanos(u64 nsec); long getpagesize(); void move_file(const vm_char *path1, const vm_char *path2); +VM_C_API LONG exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, void *dispatch); +THREADHANDLE start_thread(void *(*start_routine)(void *),void *args); +inline static THREADHANDLE thread_id() { return GetCurrentThread(); } } diff --git a/vm/platform.hpp b/vm/platform.hpp index e5a07a05d4..cdfe7fa45a 100755 --- a/vm/platform.hpp +++ b/vm/platform.hpp @@ -1,15 +1,11 @@ #if defined(WINDOWS) - #if defined(WINCE) - #include "os-windows-ce.hpp" + #if defined(WINNT) #include "os-windows.hpp" - #elif defined(WINNT) - #include "os-windows.hpp" - #include "os-windows-nt.hpp" #if defined(FACTOR_AMD64) - #include "os-windows-nt.64.hpp" + #include "os-windows.64.hpp" #elif defined(FACTOR_X86) - #include "os-windows-nt.32.hpp" + #include "os-windows.32.hpp" #else #error "Unsupported Windows flavor" #endif -- 2.34.1