Fix conflict
commit
a908aca37e
|
@ -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 [
|
||||
|
|
|
@ -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"
|
||||
|
||||
|
|
|
@ -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" }
|
||||
|
|
|
@ -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 <mapped-file> } " 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: <mapped-file>
|
||||
{ $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 <mapped-file> }
|
||||
{ $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"
|
|
@ -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: <mapped-file> 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 <mapped-file> r>
|
||||
|
|
|
@ -15,7 +15,7 @@ M: unix-io <mapped-file> ( 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
|
||||
|
|
|
@ -81,7 +81,7 @@ M: windows-io <mapped-file> ( 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
|
||||
|
|
|
@ -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
|
Loading…
Reference in New Issue