diff --git a/core/alien/compiler/compiler.factor b/core/alien/compiler/compiler.factor index 7e0165cd64..992c7763f2 100755 --- a/core/alien/compiler/compiler.factor +++ b/core/alien/compiler/compiler.factor @@ -202,23 +202,6 @@ M: alien-invoke-error summary : pop-parameters pop-literal nip [ expand-constants ] map ; -\ alien-invoke [ - ! Four literals - 4 ensure-values - \ alien-invoke empty-node - ! Compile-time parameters - pop-parameters over set-alien-invoke-parameters - pop-literal nip over set-alien-invoke-function - pop-literal nip over set-alien-invoke-library - pop-literal nip over set-alien-invoke-return - ! Quotation which coerces parameters to required types - dup make-prep-quot recursive-state get infer-quot - ! Add node to IR - dup node, - ! Magic #: consume exactly the number of inputs - 0 alien-invoke-stack -] "infer" set-word-prop - : stdcall-mangle ( symbol node -- symbol ) "@" swap alien-node-parameters parameter-sizes drop @@ -228,13 +211,38 @@ M: alien-invoke-error summary dup alien-invoke-function swap alien-invoke-library load-library ; +TUPLE: no-such-symbol ; + +M: no-such-symbol summary + drop "Symbol not found" ; + +: no-such-symbol ( -- ) + \ no-such-symbol inference-error ; + : alien-invoke-dlsym ( node -- symbol dll ) - dup (alien-invoke-dlsym) - >r over stdcall-mangle r> 2dup dlsym [ - rot drop - ] [ - 2drop (alien-invoke-dlsym) - ] if ; + dup (alien-invoke-dlsym) 2dup dlsym [ + >r over stdcall-mangle r> 2dup dlsym + [ no-such-symbol ] unless + ] unless rot drop ; + +\ alien-invoke [ + ! Four literals + 4 ensure-values + \ alien-invoke empty-node + ! Compile-time parameters + pop-parameters over set-alien-invoke-parameters + pop-literal nip over set-alien-invoke-function + pop-literal nip over set-alien-invoke-library + pop-literal nip over set-alien-invoke-return + ! If symbol doesn't resolve, no stack effect, no compile + dup alien-invoke-dlsym 2drop + ! Quotation which coerces parameters to required types + dup make-prep-quot recursive-state get infer-quot + ! Add node to IR + dup node, + ! Magic #: consume exactly the number of inputs + 0 alien-invoke-stack +] "infer" set-word-prop M: alien-invoke generate-node dup alien-invoke-frame [ diff --git a/core/system/system-docs.factor b/core/system/system-docs.factor index 4e31fd4722..d91a84ec99 100644 --- a/core/system/system-docs.factor +++ b/core/system/system-docs.factor @@ -29,7 +29,7 @@ ARTICLE: "os" "System interface" { $subsection millis } "Exiting the Factor VM:" { $subsection exit } -{ $see-also "file-streams" "network-streams" "io.launcher" } ; +{ $see-also "file-streams" "network-streams" "io.launcher" "io.mmap" } ; ABOUT: "os" diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor index c38023e544..749a5ed0ec 100644 --- a/extra/help/handbook/handbook.factor +++ b/extra/help/handbook/handbook.factor @@ -131,7 +131,7 @@ ARTICLE: "collections" "Collections" { $subsection "graphs" } { $subsection "buffers" } ; -USING: io.sockets io.launcher ; +USING: io.sockets io.launcher io.mmap ; ARTICLE: "io" "Input and output" { $subsection "streams" } @@ -145,7 +145,8 @@ ARTICLE: "io" "Input and output" { $subsection "stream-binary" } { $subsection "styles" } { $subsection "network-streams" } -{ $subsection "io.launcher" } ; +{ $subsection "io.launcher" } +{ $subsection "io.mmap" } ; ARTICLE: "tools" "Developer tools" { $subsection "tools.annotations" } diff --git a/extra/io/mmap/mmap-docs.factor b/extra/io/mmap/mmap-docs.factor new file mode 100644 index 0000000000..22e403ed31 --- /dev/null +++ b/extra/io/mmap/mmap-docs.factor @@ -0,0 +1,38 @@ +USING: help.markup help.syntax alien math ; +IN: io.mmap + +HELP: mapped-file +{ $class-description "The class of memory-mapped files, opened by " { $link } " and closed by " { $link close-mapped-file } ". The following two slots are of interest to users:" + { $list + { { $link mapped-file-length } " - the length of the mapped file area, in bytes" } + { { $link mapped-file-address } " - an " { $link alien } " pointing at the file's memory area" } + } +} ; + +HELP: +{ $values { "path" "a pathname string" } { "length" integer } { "mmap" mapped-file } } +{ $contract "Opens a file and maps the first " { $snippet "length" } " bytes into memory. The length is permitted to exceed the length of the file on disk, in which case the remaining space is padded with zero bytes." } +{ $notes "You must call " { $link close-mapped-file } " when you are finished working with the returned object, to reclaim resources. The " { $link with-mapped-file } " provides an abstraction which can close the mapped file for you." } +{ $errors "Throws an error if a memory mapping could not be established." } ; + +HELP: (close-mapped-file) +{ $values { "mmap" mapped-file } } +{ $contract "Releases system resources associated with the mapped file. This word should not be called by user code; use " { $link close-mapped-file } " instead." } +{ $errors "Throws an error if a memory mapping could not be established." } ; + +HELP: close-mapped-file +{ $values { "mmap" mapped-file } } +{ $description "Releases system resources associated with the mapped file." } +{ $errors "Throws an error if a memory mapping could not be established." } ; + +ARTICLE: "io.mmap" "Memory-mapped files" +"The " { $vocab-link "io.mmap" } " vocabulary implements support for memory-mapped files." +{ $subsection } +{ $subsection close-mapped-file } +"A combinator which wraps the above two words:" +{ $subsection with-mapped-file } +"Memory mapped files implement the " { $link "sequence-protocol" } " and present themselves as a sequence of bytes. The underlying memory area can also be accessed directly:" +{ $subsection mapped-file-address } +"Data can be read and written from the memory area using alien words. See " { $link "reading-writing-memory" } "." ; + +ABOUT: "io.mmap" diff --git a/extra/io/mmap/mmap.factor b/extra/io/mmap/mmap.factor index f9ccd61423..aaa786f6a4 100755 --- a/extra/io/mmap/mmap.factor +++ b/extra/io/mmap/mmap.factor @@ -4,20 +4,31 @@ USING: continuations io.backend kernel quotations sequences system alien sequences.private ; IN: io.mmap -TUPLE: mapped-file length address handle ; +TUPLE: mapped-file length address handle closed? ; -M: mapped-file length mapped-file-length ; +: check-closed ( mapped-file -- mapped-file ) + dup mapped-file-closed? [ + "Mapped file is closed" throw + ] when ; inline + +M: mapped-file length check-closed mapped-file-length ; M: mapped-file nth-unsafe - mapped-file-address swap alien-unsigned-1 ; + check-closed mapped-file-address swap alien-unsigned-1 ; M: mapped-file set-nth-unsafe - mapped-file-address swap set-alien-unsigned-1 ; + check-closed mapped-file-address swap set-alien-unsigned-1 ; INSTANCE: mapped-file sequence HOOK: io-backend ( path length -- mmap ) -HOOK: close-mapped-file io-backend ( mmap -- ) + +HOOK: (close-mapped-file) io-backend ( mmap -- ) + +: close-mapped-file ( mmap -- ) + check-closed + t over set-mapped-file-closed? + (close-mapped-file) ; : with-mapped-file ( path length quot -- ) >r r> diff --git a/extra/io/unix/mmap/mmap.factor b/extra/io/unix/mmap/mmap.factor index 50e928f16d..d7dcad67d9 100644 --- a/extra/io/unix/mmap/mmap.factor +++ b/extra/io/unix/mmap/mmap.factor @@ -15,7 +15,7 @@ M: unix-io ( path length -- obj ) dup PROT_READ PROT_WRITE bitor MAP_FILE MAP_SHARED bitor r> mmap-open \ mapped-file construct-boa ; -M: unix-io close-mapped-file ( mmap -- ) +M: unix-io (close-mapped-file) ( mmap -- ) [ mapped-file-address ] keep [ mapped-file-length munmap ] keep mapped-file-handle close diff --git a/extra/io/windows/mmap/mmap.factor b/extra/io/windows/mmap/mmap.factor index b291bb6bcd..20c6a6fc22 100755 --- a/extra/io/windows/mmap/mmap.factor +++ b/extra/io/windows/mmap/mmap.factor @@ -81,7 +81,7 @@ M: windows-io ( path length -- mmap ) \ mapped-file construct-boa ] with-destructors ; -M: windows-io close-mapped-file ( mapped-file -- ) +M: windows-io (close-mapped-file) ( mapped-file -- ) [ dup mapped-file-handle [ close-always ] each mapped-file-address UnmapViewOfFile win32-error=0/f diff --git a/extra/io/windows/windows-tests.factor b/extra/io/windows/windows-tests.factor new file mode 100755 index 0000000000..4c090590df --- /dev/null +++ b/extra/io/windows/windows-tests.factor @@ -0,0 +1,16 @@ +USING: io.files kernel tools.test ; +IN: temporary + +[ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test +[ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test +[ "c:\\" ] [ "c:\\foo" parent-directory ] unit-test +! { "c:" "c:\\" "c:/" } [ directory ] each -- all do the same thing +[ "c:\\" ] [ "c:\\" parent-directory ] unit-test +[ "Z:\\" ] [ "Z:\\" parent-directory ] unit-test +[ "c:" ] [ "c:" parent-directory ] unit-test +[ "Z:" ] [ "Z:" parent-directory ] unit-test +[ t ] [ "c:\\" root-directory? ] unit-test +[ t ] [ "Z:\\" root-directory? ] unit-test +[ f ] [ "c:\\foo" root-directory? ] unit-test +[ f ] [ "." root-directory? ] unit-test +[ f ] [ ".." root-directory? ] unit-test