From 27ebd08b99f54c55a5dfb84f3885cdd19d16e4b0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 1 Feb 2008 16:21:42 -0600 Subject: [PATCH 1/3] Encodings fix --- core/io/encodings/encodings.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 83ab576faf..5bc679cd27 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -18,7 +18,7 @@ SYMBOL: begin over push 0 begin ; : finish-decoding ( buf ch state -- str ) - begin eq? [ decode-error ] unless drop { } like ; + begin eq? [ decode-error ] unless drop "" like ; : decode ( seq quot -- str ) >r [ length 0 begin ] keep r> each From f710d192f7e14ab4037ad35ef0269d95534bf627 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 1 Feb 2008 17:13:57 -0600 Subject: [PATCH 2/3] Fix inaccurate notifications in io.monitor on Windows --- extra/io/monitor/monitor-docs.factor | 33 ++++++++++------------ extra/io/monitor/monitor.factor | 9 +++--- extra/io/windows/launcher/launcher.factor | 11 ++++++-- extra/io/windows/nt/monitor/monitor.factor | 32 ++++++++------------- extra/windows/kernel32/kernel32.factor | 6 ++++ 5 files changed, 46 insertions(+), 45 deletions(-) diff --git a/extra/io/monitor/monitor-docs.factor b/extra/io/monitor/monitor-docs.factor index 56fd203bde..de649f48e7 100755 --- a/extra/io/monitor/monitor-docs.factor +++ b/extra/io/monitor/monitor-docs.factor @@ -8,35 +8,32 @@ $nl "Not all operating systems support recursive monitors; if recursive monitoring is not available, an error is thrown and the caller must implement alternative logic for monitoring subdirectories." } ; HELP: next-change -{ $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changes" "a sequence of change descriptors" } } -{ $description "Waits for file system changes and outputs the pathname of the first changed file. The change descriptor is a sequence containing at least one change descriptor; see " { $link "io.monitor.descriptors" } "." } ; +{ $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changes" "a change descriptor" } } +{ $description "Waits for file system changes and outputs the pathname of the first changed file. The change descriptor is aq sequence of symbols documented in " { $link "io.monitor.descriptors" } "." } ; HELP: with-monitor { $values { "path" "a pathname string" } { "recursive?" "a boolean" } { "quot" "a quotation with stack effect " { $snippet "( monitor -- )" } } } { $description "Opens a file system change monitor and passes it to the quotation. Closes the monitor after the quotation returns or throws an error." } ; -HELP: +change-file+ -{ $description "Indicates that the contents of the file have changed." } ; +HELP: +add-file+ +{ $description "Indicates that the file has been added to the directory." } ; -HELP: +change-name+ -{ $description "Indicates that the file name has changed." } ; +HELP: +remove-file+ +{ $description "Indicates that the file has been removed from the directory." } ; -HELP: +change-size+ -{ $description "Indicates that the file size has changed." } ; +HELP: +modify-file+ +{ $description "Indicates that the file contents have changed." } ; -HELP: +change-attributes+ -{ $description "Indicates that file attributes has changed. Attributes are operating system-specific but may include the creation time and permissions." } ; - -HELP: +change-modified+ -{ $description "Indicates that the last modification time of the file has changed." } ; +HELP: +rename-file+ +{ $description "Indicates that file has been renamed." } ; ARTICLE: "io.monitor.descriptors" "File system change descriptors" "Change descriptors output by " { $link next-change } ":" -{ $subsection +change-file+ } -{ $subsection +change-name+ } -{ $subsection +change-size+ } -{ $subsection +change-attributes+ } -{ $subsection +change-modified+ } ; +{ $subsection +add-file+ } +{ $subsection +remove-file+ } +{ $subsection +modify-file+ } +{ $subsection +rename-file+ } +{ $subsection +add-file+ } ; ARTICLE: "io.monitor" "File system change monitors" "File system change monitors listen for changes to file names, attributes and contents under a specified directory. They can optionally be recursive, in which case subdirectories are also monitored." diff --git a/extra/io/monitor/monitor.factor b/extra/io/monitor/monitor.factor index 044fa9572b..4dc5081513 100755 --- a/extra/io/monitor/monitor.factor +++ b/extra/io/monitor/monitor.factor @@ -7,11 +7,10 @@ HOOK: io-backend ( path recursive? -- monitor ) HOOK: next-change io-backend ( monitor -- path changes ) -SYMBOL: +change-file+ -SYMBOL: +change-name+ -SYMBOL: +change-size+ -SYMBOL: +change-attributes+ -SYMBOL: +change-modified+ +SYMBOL: +add-file+ +SYMBOL: +remove-file+ +SYMBOL: +modify-file+ +SYMBOL: +rename-file+ : with-monitor ( path recursive? quot -- ) >r r> with-disposal ; inline diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor index 8f1d1c6756..ec53d9152c 100755 --- a/extra/io/windows/launcher/launcher.factor +++ b/extra/io/windows/launcher/launcher.factor @@ -119,8 +119,15 @@ TUPLE: CreateProcess-args drop STD_ERROR_HANDLE GetStdHandle ; : redirect-stderr ( args -- handle ) - +stderr+ get GENERIC_WRITE CREATE_ALWAYS redirect - swap inherited-stderr ?closed ; + +stderr+ get + dup +stdout+ eq? [ + drop + CreateProcess-args-lpStartupInfo + STARTUPINFO-hStdOutput + ] [ + GENERIC_WRITE CREATE_ALWAYS redirect + swap inherited-stderr ?closed + ] if ; : inherited-stdin ( args -- handle ) CreateProcess-args-stdin-pipe diff --git a/extra/io/windows/nt/monitor/monitor.factor b/extra/io/windows/nt/monitor/monitor.factor index a7c065b878..8e0e63923d 100755 --- a/extra/io/windows/nt/monitor/monitor.factor +++ b/extra/io/windows/nt/monitor/monitor.factor @@ -4,7 +4,7 @@ USING: alien.c-types destructors io.windows io.windows.nt.backend kernel math windows windows.kernel32 windows.types libc assocs alien namespaces continuations io.monitor io.nonblocking io.buffers io.files io sequences -hashtables sorting arrays ; +hashtables sorting arrays combinators ; IN: io.windows.nt.monitor TUPLE: monitor path recursive? queue closed? ; @@ -53,25 +53,17 @@ M: windows-nt-io ( path recursive? -- monitor ) ] with-port-timeout ] with-destructors ; -: parse-action-flag ( action mask symbol -- action ) - >r over bitand 0 > [ r> , ] [ r> drop ] if ; +: parse-action ( action -- changed ) + { + { [ dup FILE_ACTION_ADDED = ] [ +add-file+ ] } + { [ dup FILE_ACTION_REMOVED = ] [ +remove-file+ ] } + { [ dup FILE_ACTION_MODIFIED = ] [ +modify-file+ ] } + { [ dup FILE_ACTION_RENAMED_OLD_NAME = ] [ +rename-file+ ] } + { [ dup FILE_ACTION_RENAMED_NEW_NAME = ] [ +rename-file+ ] } + { [ t ] [ +modify-file+ ] } + } cond nip ; -: parse-action ( action -- changes ) - [ - FILE_NOTIFY_CHANGE_FILE +change-file+ parse-action-flag - FILE_NOTIFY_CHANGE_DIR_NAME +change-name+ parse-action-flag - FILE_NOTIFY_CHANGE_ATTRIBUTES +change-attributes+ parse-action-flag - FILE_NOTIFY_CHANGE_SIZE +change-size+ parse-action-flag - FILE_NOTIFY_CHANGE_LAST_WRITE +change-modified+ parse-action-flag - FILE_NOTIFY_CHANGE_LAST_ACCESS +change-attributes+ parse-action-flag - FILE_NOTIFY_CHANGE_EA +change-attributes+ parse-action-flag - FILE_NOTIFY_CHANGE_CREATION +change-attributes+ parse-action-flag - FILE_NOTIFY_CHANGE_SECURITY +change-attributes+ parse-action-flag - FILE_NOTIFY_CHANGE_FILE_NAME +change-name+ parse-action-flag - drop - ] { } make ; - -: changed-file ( directory buffer -- changes path ) +: changed-file ( directory buffer -- changed path ) { FILE_NOTIFY_INFORMATION-FileName FILE_NOTIFY_INFORMATION-FileNameLength @@ -79,7 +71,7 @@ M: windows-nt-io ( path recursive? -- monitor ) } get-slots >r memory>u16-string path+ r> parse-action swap ; : (changed-files) ( directory buffer -- ) - 2dup changed-file namespace [ append ] change-at + 2dup changed-file namespace [ swap add ] change-at dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero? [ 3drop ] [ swap (changed-files) ] if ; diff --git a/extra/windows/kernel32/kernel32.factor b/extra/windows/kernel32/kernel32.factor index 15bdcd3e37..77c7666bfd 100755 --- a/extra/windows/kernel32/kernel32.factor +++ b/extra/windows/kernel32/kernel32.factor @@ -83,6 +83,12 @@ IN: windows.kernel32 : FILE_NOTIFY_CHANGE_FILE_NAME HEX: 200 ; inline : FILE_NOTIFY_CHANGE_ALL HEX: 3ff ; inline +: FILE_ACTION_ADDED 1 ; inline +: FILE_ACTION_REMOVED 2 ; inline +: FILE_ACTION_MODIFIED 3 ; inline +: FILE_ACTION_RENAMED_OLD_NAME 4 ; inline +: FILE_ACTION_RENAMED_NEW_NAME 5 ; inline + C-STRUCT: FILE_NOTIFY_INFORMATION { "DWORD" "NextEntryOffset" } { "DWORD" "Action" } From 3917a9472a4f8ee66f145e1de5c60cc3e45919d7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 1 Feb 2008 17:14:10 -0600 Subject: [PATCH 3/3] Implement default_vm_path() on netbsd --- vm/os-netbsd.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) mode change 100644 => 100755 vm/os-netbsd.c diff --git a/vm/os-netbsd.c b/vm/os-netbsd.c old mode 100644 new mode 100755 index b9238b7877..c33b4ad69c --- a/vm/os-netbsd.c +++ b/vm/os-netbsd.c @@ -1,6 +1,11 @@ #include "master.h" +extern int main(); + const char *vm_executable_path(void) { - return NULL; + static Dl_info info = {0}; + if (!info.dli_fname) + dladdr(main, &info); + return info.dli_fname; }