Fix conflict

release
Slava Pestov 2007-11-17 23:08:11 -05:00
commit a908aca37e
8 changed files with 107 additions and 33 deletions

View File

@ -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 [

View File

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

View File

@ -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" }

View File

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

View File

@ -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>

View File

@ -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

View File

@ -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

View File

@ -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