Cleanup

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 )
 
 : <mapped-file> ( 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
+    dup closed>> [ drop ] [
-    t over set-mapped-file-closed?
+        t >>closed close-mapped-file
-    close-mapped-file ;
+    ] if ;
 
 : with-mapped-file ( path length quot -- )
     >r <mapped-file> r> with-disposal ; inline

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
+USING: alien io io.files kernel math math.bitfields system unix
-io.mmap destructors ;
+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 } flags
-    PROT_READ PROT_WRITE bitor
+    { MAP_FILE MAP_SHARED } flags
-    MAP_FILE MAP_SHARED bitor
+    r> mmap-open ;
-    r> mmap-open f mapped-file boa ;
 
 M: unix close-mapped-file ( mmap -- )
     [ [ address>> ] [ length>> ] bi munmap io-error ]

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 ) ;