diff --git a/core/system/system-docs.factor b/core/system/system-docs.factor index d0b2cfb194..5aac0a8e8c 100755 --- a/core/system/system-docs.factor +++ b/core/system/system-docs.factor @@ -101,7 +101,7 @@ HELP: set-os-envs { $values { "assoc" "an association mapping strings to strings" } } { $description "Replaces the current set of environment variables." } { $notes - "Names and values of environment variables are operating system-specific." + "Names and values of environment variables are operating system-specific. Windows NT allows values up to 32766 characters in length." } { $errors "Windows CE has no concept of environment variables, so this word throws an error there." } ; diff --git a/core/system/system-tests.factor b/core/system/system-tests.factor index d5a48080c2..c731a14725 100755 --- a/core/system/system-tests.factor +++ b/core/system/system-tests.factor @@ -1,4 +1,5 @@ -USING: math tools.test system prettyprint namespaces kernel ; +USING: math tools.test system prettyprint namespaces kernel +strings sequences ; IN: system.tests os wince? [ @@ -19,3 +20,8 @@ os unix? [ [ ] [ "factor-test-key-1" unset-os-env ] unit-test [ f ] [ "factor-test-key-1" os-env ] unit-test +[ ] [ + 32766 CHAR: a "factor-test-key-long" set-os-env +] unit-test +[ 32766 ] [ "factor-test-key-long" os-env length ] unit-test +[ ] [ "factor-test-key-long" unset-os-env ] unit-test diff --git a/extra/io/monitors/monitors.factor b/extra/io/monitors/monitors.factor index 51cbdd5b1b..5c88968ee7 100755 --- a/extra/io/monitors/monitors.factor +++ b/extra/io/monitors/monitors.factor @@ -1,51 +1,55 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: io.backend kernel continuations namespaces sequences -assocs hashtables sorting arrays threads boxes io.timeouts -accessors concurrency.mailboxes ; -IN: io.monitors - -HOOK: init-monitors io-backend ( -- ) - -HOOK: dispose-monitors io-backend ( -- ) - -: with-monitors ( quot -- ) - [ - init-monitors - [ dispose-monitors ] [ ] cleanup - ] with-scope ; inline - -TUPLE: monitor < identity-tuple path queue timeout ; - -M: monitor hashcode* path>> hashcode* ; - -M: monitor timeout timeout>> ; - -M: monitor set-timeout (>>timeout) ; - -: construct-monitor ( path mailbox class -- monitor ) - construct-empty - swap >>queue - swap >>path ; inline - -: queue-change ( path changes monitor -- ) - 3dup and and - [ [ 3array ] keep queue>> mailbox-put ] [ 3drop ] if ; - -HOOK: (monitor) io-backend ( path recursive? mailbox -- monitor ) - -: ( path recursive? -- monitor ) - (monitor) ; - -: next-change ( monitor -- path changed ) - [ queue>> ] [ timeout ] bi mailbox-get-timeout first2 ; - -SYMBOL: +add-file+ -SYMBOL: +remove-file+ -SYMBOL: +modify-file+ -SYMBOL: +rename-file-old+ -SYMBOL: +rename-file-new+ -SYMBOL: +rename-file+ - -: with-monitor ( path recursive? quot -- ) - >r r> with-disposal ; inline +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: io.backend kernel continuations namespaces sequences +assocs hashtables sorting arrays threads boxes io.timeouts +accessors concurrency.mailboxes ; +IN: io.monitors + +HOOK: init-monitors io-backend ( -- ) + +M: object init-monitors ; + +HOOK: dispose-monitors io-backend ( -- ) + +M: object dispose-monitors ; + +: with-monitors ( quot -- ) + [ + init-monitors + [ dispose-monitors ] [ ] cleanup + ] with-scope ; inline + +TUPLE: monitor < identity-tuple path queue timeout ; + +M: monitor hashcode* path>> hashcode* ; + +M: monitor timeout timeout>> ; + +M: monitor set-timeout (>>timeout) ; + +: construct-monitor ( path mailbox class -- monitor ) + construct-empty + swap >>queue + swap >>path ; inline + +: queue-change ( path changes monitor -- ) + 3dup and and + [ [ 3array ] keep queue>> mailbox-put ] [ 3drop ] if ; + +HOOK: (monitor) io-backend ( path recursive? mailbox -- monitor ) + +: ( path recursive? -- monitor ) + (monitor) ; + +: next-change ( monitor -- path changed ) + [ queue>> ] [ timeout ] bi mailbox-get-timeout first2 ; + +SYMBOL: +add-file+ +SYMBOL: +remove-file+ +SYMBOL: +modify-file+ +SYMBOL: +rename-file-old+ +SYMBOL: +rename-file-new+ +SYMBOL: +rename-file+ + +: with-monitor ( path recursive? quot -- ) + >r r> with-disposal ; inline diff --git a/extra/io/unix/bsd/bsd.factor b/extra/io/unix/bsd/bsd.factor index 1b51b3c4e4..d74c355642 100755 --- a/extra/io/unix/bsd/bsd.factor +++ b/extra/io/unix/bsd/bsd.factor @@ -13,10 +13,6 @@ M: bsd init-io ( -- ) [ mx get-global reads>> set-at ] [ mx get-global writes>> set-at ] 2bi ; -M: bsd init-monitors ; - -M: bsd dispose-monitors ; - M: bsd (monitor) ( path recursive? mailbox -- ) swap [ "Recursive kqueue monitors not supported" throw ] when ; diff --git a/extra/io/unix/macosx/macosx.factor b/extra/io/unix/macosx/macosx.factor index 68eb2f13bb..60ba4c08b3 100644 --- a/extra/io/unix/macosx/macosx.factor +++ b/extra/io/unix/macosx/macosx.factor @@ -12,10 +12,6 @@ TUPLE: macosx-monitor < monitor handle ; >r first { +modify-file+ } r> queue-change ] curry each ; -M: macosx init-monitors ; - -M: macosx dispose-monitors ; - M:: macosx (monitor) ( path recursive? mailbox -- monitor ) path mailbox macosx-monitor construct-monitor dup [ enqueue-notifications ] curry diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index 745b9f6afc..eec473e840 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -3,7 +3,7 @@ io.timeouts io.nonblocking io.windows io.windows.nt.backend kernel libc math threads windows windows.kernel32 system alien.c-types alien.arrays sequences combinators combinators.lib sequences.lib ascii splitting alien strings assocs namespaces -io.files.private ; +io.files.private accessors ; IN: io.windows.nt.files M: winnt cwd @@ -87,9 +87,9 @@ M: port port-flush : finish-read ( overlapped port -- ) dup pending-error tuck get-overlapped-result dup zero? [ - drop t swap set-port-eof? + drop t >>eof drop ] [ - dup pick n>buffer + dup pick buffer>> n>buffer swap update-file-ptr ] if ; diff --git a/extra/io/windows/nt/monitors/monitors.factor b/extra/io/windows/nt/monitors/monitors.factor index 7293b39064..7f3a13b281 100755 --- a/extra/io/windows/nt/monitors/monitors.factor +++ b/extra/io/windows/nt/monitors/monitors.factor @@ -4,7 +4,7 @@ USING: alien alien.c-types libc destructors locals kernel math assocs namespaces continuations sequences hashtables sorting arrays combinators math.bitfields strings system io.windows io.windows.nt.backend io.monitors io.nonblocking -io.buffers io.files io.timeouts io +io.buffers io.files io.timeouts io accessors threads windows windows.kernel32 windows.types ; IN: io.windows.nt.monitors @@ -21,7 +21,9 @@ IN: io.windows.nt.monitors dup add-completion f ; -TUPLE: win32-monitor < monitor port recursive ; +TUPLE: win32-monitor-port < input-port recursive ; + +TUPLE: win32-monitor < monitor port ; : begin-reading-changes ( port -- overlapped ) { @@ -83,9 +85,11 @@ TUPLE: win32-monitor < monitor port recursive ; M:: winnt (monitor) ( path recursive? mailbox -- monitor ) [ path mailbox win32-monitor construct-monitor - path open-directory >>port - recursive? >>recursive - dup port>> [ fill-queue-thread ] curry spawn drop + path open-directory \ win32-monitor-port + recursive? >>recursive + >>port + dup [ fill-queue-thread ] curry + "Windows monitor thread" spawn drop ] with-destructors ; M: win32-monitor dispose diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor index c0dc0afd06..a9d487dad7 100755 --- a/extra/io/windows/nt/sockets/sockets.factor +++ b/extra/io/windows/nt/sockets/sockets.factor @@ -2,7 +2,7 @@ USING: alien alien.accessors alien.c-types byte-arrays continuations destructors io.nonblocking io.timeouts io.sockets io.sockets.impl io namespaces io.streams.duplex io.windows io.windows.nt.backend windows.winsock kernel libc math sequences -threads classes.tuple.lib system ; +threads classes.tuple.lib system accessors ; IN: io.windows.nt.sockets : malloc-int ( object -- object ) diff --git a/vm/os-windows.c b/vm/os-windows.c index 136168807a..59c14d98f5 100755 --- a/vm/os-windows.c +++ b/vm/os-windows.c @@ -218,9 +218,9 @@ void sleep_millis(DWORD msec) DEFINE_PRIMITIVE(os_env) { F_CHAR *key = unbox_u16_string(); - F_CHAR *value = safe_malloc(MAX_UNICODE_PATH); + F_CHAR *value = safe_malloc(MAX_UNICODE_PATH * 2); int ret; - ret = GetEnvironmentVariable(key, value, MAX_UNICODE_PATH); + ret = GetEnvironmentVariable(key, value, MAX_UNICODE_PATH * 2); if(ret == 0) dpush(F); else