]> gitweb.factorcode.org Git - factor.git/commitdiff
io.directories: faster directory-entries by caching dirent structs.
authorJohn Benediktsson <mrjbq7@gmail.com>
Tue, 29 Apr 2014 20:22:56 +0000 (13:22 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Tue, 29 Apr 2014 20:22:56 +0000 (13:22 -0700)
basis/io/directories/directories.factor
basis/io/directories/unix/linux/linux.factor
basis/io/directories/unix/unix.factor
basis/io/directories/windows/windows.factor

index 91401515f53cfa2a12ec70e00bb5184206fe0844..86c2778cd7bc2aae7a73780071073aa7609ee384 100644 (file)
@@ -31,7 +31,7 @@ HOOK: make-directory io-backend ( path -- )
 ! Listing directories
 TUPLE: directory-entry name type ;
 
-HOOK: >directory-entry os ( byte-array -- directory-entry )
+C: <directory-entry> directory-entry
 
 HOOK: (directory-entries) os ( path -- seq )
 
index 318a870a5b027534ec54f09aa7b202b1a6344e3f..75a6ba7a8a4bfb490311580b2db6db58385fd7e2 100644 (file)
@@ -1,11 +1,16 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types alien.data io.directories.unix kernel libc
-system unix classes.struct unix.ffi ;
+math system unix classes.struct unix.ffi ;
 IN: io.directories.unix.linux
 
-M: linux find-next-file ( DIR* -- dirent )
-    dirent <struct>
-    f void* <ref>
-    [ [ readdir64_r ] unix-system-call 0 = [ (io-error) ] unless ] 2keep
-    void* deref [ drop f ] unless ;
+: next-dirent ( DIR* dirent* -- dirent* ? )
+    f void* <ref> [
+        readdir64_r [ dup strerror libc-error ] unless-zero
+    ] 2keep void* deref ; inline
+
+M: linux (directory-entries) ( path -- seq )
+    [
+        dirent <struct>
+        '[ _ _ next-dirent ] [ >directory-entry ] produce nip
+    ] with-unix-directory ;
index 8170075cd1aaf09e74ce9697ffaedc0c0579cb3a..a17a8180dfc2ce3214e26c019cff506c94356e56 100644 (file)
@@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.data alien.strings
 assocs combinators continuations destructors fry io io.backend
 io.directories io.encodings.binary io.files.info.unix
 io.encodings.utf8 io.files io.pathnames io.files.types kernel
-math.bitwise sequences system unix unix.stat vocabs.loader
+math math.bitwise sequences system unix unix.stat vocabs.loader
 classes.struct unix.ffi literals libc vocabs io.files.info ;
 IN: io.directories.unix
 
@@ -40,15 +40,6 @@ M: unix copy-file ( from to -- )
         dupd curry swap '[ _ closedir io-error ] [ ] cleanup
     ] with-directory ; inline
 
-HOOK: find-next-file os ( DIR* -- byte-array )
-
-M: unix find-next-file ( DIR* -- byte-array )
-    dirent <struct>
-    f void* <ref>
-    0 set-errno
-    [ readdir_r 0 = [ errno 0 = [ (io-error) ] unless ] unless ] 2keep
-    void* deref [ drop f ] unless ;
-
 : dirent-type>file-type ( type -- file-type )
     H{
         { $ DT_BLK  +block-device+ }
@@ -63,25 +54,22 @@ M: unix find-next-file ( DIR* -- byte-array )
 
 ! An easy way to return +unknown+ is to mount a .iso on OSX and
 ! call directory-entries on the mount point.
-: dirent>file-type ( dirent -- type )
-    dup d_type>> dirent-type>file-type
-    dup +unknown+ = [
-        drop d_name>> utf8 alien>string file-info type>>
-    ] [
-        nip
-    ] if ;
 
-M: unix >directory-entry ( byte-array -- directory-entry )
-    {
-        [ d_name>> underlying>> utf8 alien>string ]
-        [ dirent>file-type ]
-    } cleave directory-entry boa ;
+: next-dirent ( DIR* dirent* -- dirent* ? )
+    f void* <ref> [
+        readdir_r [ dup strerror libc-error ] unless-zero
+    ] 2keep void* deref ; inline
+
+: >directory-entry ( dirent* -- directory-entry )
+    [ d_name>> utf8 alien>string ]
+    [ d_type>> dirent-type>file-type ] bi
+    dup +unknown+ = [ drop dup file-info type>> ] when
+    <directory-entry> ; inline
 
 M: unix (directory-entries) ( path -- seq )
     [
-        '[ _ find-next-file dup ]
-        [ >directory-entry ]
-        produce nip
+        dirent <struct>
+        '[ _ _ next-dirent ] [ >directory-entry ] produce nip
     ] with-unix-directory ;
 
 os linux? [ "io.directories.unix.linux" require ] when
index 46ce2ec44101d979f76bba8b63308049c369c7f5..2168eeffeddf2e475996e63bedf5aa1a50fb94ba 100644 (file)
@@ -48,13 +48,11 @@ M: windows delete-directory ( path -- )
     normalize-path
     RemoveDirectory win32-error=0/f ;
 
-: find-first-file ( path -- WIN32_FIND_DATA handle )
-    WIN32_FIND_DATA <struct>
+: find-first-file ( path WIN32_FIND_DATA -- WIN32_FIND_DATA HANDLE )
     [ nip ] [ FindFirstFile ] 2bi
     [ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ;
 
-: find-next-file ( path -- WIN32_FIND_DATA/f )
-    WIN32_FIND_DATA <struct>
+: find-next-file ( HANDLE WIN32_FIND_DATA -- WIN32_FIND_DATA/f )
     [ nip ] [ FindNextFile ] 2bi 0 = [
         GetLastError ERROR_NO_MORE_FILES = [
             win32-error
@@ -63,23 +61,27 @@ M: windows delete-directory ( path -- )
 
 TUPLE: windows-directory-entry < directory-entry attributes ;
 
-M: windows >directory-entry ( byte-array -- directory-entry )
+C: <windows-directory-entry> windows-directory-entry
+
+: >windows-directory-entry ( WIN32_FIND_DATA -- directory-entry )
     [ cFileName>> alien>native-string ]
     [
         dwFileAttributes>>
         [ win32-file-type ] [ win32-file-attributes ] bi
     ] bi
-    dupd remove windows-directory-entry boa ;
+    dupd remove <windows-directory-entry> ; inline
 
 M: windows (directory-entries) ( path -- seq )
     "\\" ?tail drop "\\*" append
-    find-first-file [ >directory-entry ] dip
+    WIN32_FIND_DATA <struct>
+    find-first-file over
+    [ >windows-directory-entry ] 2dip
     [
         '[
-            [ _ find-next-file dup ]
-            [ >directory-entry ]
+            [ _ find-next-file dup ]
+            [ >windows-directory-entry ]
             produce nip
             over name>> "." = [ nip ] [ swap prefix ] if
         ]
-    ] [ '[ _ FindClose win32-error=0/f ] ] bi [ ] cleanup ;
+    ] [ drop '[ _ FindClose win32-error=0/f ] ] 2bi [ ] cleanup ;