diff --git a/extra/io/mmap/mmap.factor b/extra/io/mmap/mmap.factor index a07443783c..2f637a4f81 100755 --- a/extra/io/mmap/mmap.factor +++ b/extra/io/mmap/mmap.factor @@ -1,37 +1,38 @@ ! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: continuations io.backend kernel quotations sequences -system alien alien.accessors sequences.private ; +system alien alien.accessors accessors sequences.private ; IN: io.mmap -TUPLE: mapped-file length address handle closed? ; +TUPLE: mapped-file address handle length closed ; : check-closed ( mapped-file -- mapped-file ) - dup mapped-file-closed? [ + dup closed>> [ "Mapped file is closed" throw ] when ; inline -M: mapped-file length check-closed mapped-file-length ; +M: mapped-file length check-closed length>> ; M: mapped-file nth-unsafe - check-closed mapped-file-address swap alien-unsigned-1 ; + check-closed address>> swap alien-unsigned-1 ; M: mapped-file set-nth-unsafe - check-closed mapped-file-address swap set-alien-unsigned-1 ; + check-closed address>> swap set-alien-unsigned-1 ; INSTANCE: mapped-file sequence -HOOK: (mapped-file) io-backend ( path length -- mmap ) +HOOK: (mapped-file) io-backend ( path length -- address handle ) : ( path length -- mmap ) - >r normalize-path r> (mapped-file) ; + [ >r normalize-path r> (mapped-file) ] keep + f mapped-file boa ; HOOK: close-mapped-file io-backend ( mmap -- ) M: mapped-file dispose ( mmap -- ) - check-closed - t over set-mapped-file-closed? - close-mapped-file ; + dup closed>> [ drop ] [ + t >>closed close-mapped-file + ] if ; : with-mapped-file ( path length quot -- ) >r r> with-disposal ; inline diff --git a/extra/io/unix/mmap/mmap.factor b/extra/io/unix/mmap/mmap.factor index b6f0afb16e..3798f422d8 100755 --- a/extra/io/unix/mmap/mmap.factor +++ b/extra/io/unix/mmap/mmap.factor @@ -1,23 +1,23 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien io io.files kernel math system unix io.unix.backend -io.mmap destructors ; +USING: alien io io.files kernel math math.bitfields system unix +io.unix.backend io.ports io.mmap destructors locals accessors ; IN: io.unix.mmap : open-r/w ( path -- fd ) O_RDWR file-mode open-file ; -: mmap-open ( length prot flags path -- alien fd ) +:: mmap-open ( length prot flags path -- alien fd ) [ - >r f -roll r> open-r/w dup close-later + f length prot flags + path open-r/w dup close-later [ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep ] with-destructors ; -M: unix (mapped-file) ( path length -- obj ) +M: unix (mapped-file) swap >r - dup - PROT_READ PROT_WRITE bitor - MAP_FILE MAP_SHARED bitor - r> mmap-open f mapped-file boa ; + { PROT_READ PROT_WRITE } flags + { MAP_FILE MAP_SHARED } flags + r> mmap-open ; M: unix close-mapped-file ( mmap -- ) [ [ address>> ] [ length>> ] bi munmap io-error ] diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 2ac0a3bfa0..5608f229f0 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -4,7 +4,7 @@ USING: alien alien.c-types alien.syntax kernel libc structs sequences continuations byte-arrays strings math namespaces system combinators vocabs.loader qualified - accessors inference macros fry arrays.lib + accessors inference macros locals shuffle arrays.lib unix.types ; IN: unix @@ -50,20 +50,27 @@ LIBRARY: factor FUNCTION: void clear_err_no ( ) ; FUNCTION: int err_no ( ) ; -ERROR: unix-system-call-error word args message ; - -DEFER: strerror - -MACRO: unix-system-call ( quot -- ) - [ ] [ infer in>> ] [ first ] tri - '[ - [ @ dup 0 < [ dup throw ] [ ] if ] - [ drop , narray , swap err_no strerror unix-system-call-error ] - recover - ] ; - LIBRARY: libc +ERROR: unix-system-call-error args message word ; + +FUNCTION: char* strerror ( int errno ) ; + +MACRO:: unix-system-call ( quot -- ) + [let | n [ quot infer in>> ] + word [ quot first ] | + [ + n ndup quot call dup 0 < [ + drop + n narray + err_no strerror + word unix-system-call-error + ] [ + n nnip + ] if + ] + ] ; + FUNCTION: int accept ( int s, void* sockaddr, socklen_t* socklen ) ; FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ; FUNCTION: int chdir ( char* path ) ; @@ -162,7 +169,6 @@ FUNCTION: int setreuid ( uid_t ruid, uid_t euid ) ; FUNCTION: int setsockopt ( int s, int level, int optname, void* optval, socklen_t optlen ) ; FUNCTION: int setuid ( uid_t uid ) ; FUNCTION: int socket ( int domain, int type, int protocol ) ; -FUNCTION: char* strerror ( int errno ) ; FUNCTION: int symlink ( char* path1, char* path2 ) ; FUNCTION: int system ( char* command ) ;