Merge branch 'master' of git://factorcode.org/git/factor

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." } ;
 

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 <string> "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

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 )
-
-: <monitor> ( path recursive? -- monitor )
-    <mailbox> (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 <monitor> 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 )
+
+: <monitor> ( path recursive? -- monitor )
+    <mailbox> (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 <monitor> r> with-disposal ; inline

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

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

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 ;
 

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 <win32-file> ;
 
-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 <buffered-port> >>port
-            recursive? >>recursive
-        dup port>> [ fill-queue-thread ] curry spawn drop
+            path open-directory \ win32-monitor-port <buffered-port>
+                recursive? >>recursive
+            >>port
+        dup [ fill-queue-thread ] curry
+        "Windows monitor thread" spawn drop
     ] with-destructors ;
 
 M: win32-monitor dispose

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 )

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