io.directories: faster directory-entries by caching dirent structs.

db4
John Benediktsson 2014-04-29 13:22:56 -07:00
parent 24d345cdd9
commit 26ff963758
4 changed files with 37 additions and 42 deletions

View File

@ -31,7 +31,7 @@ HOOK: make-directory io-backend ( path -- )
! Listing directories ! Listing directories
TUPLE: directory-entry name type ; TUPLE: directory-entry name type ;
HOOK: >directory-entry os ( byte-array -- directory-entry ) C: <directory-entry> directory-entry
HOOK: (directory-entries) os ( path -- seq ) HOOK: (directory-entries) os ( path -- seq )

View File

@ -1,11 +1,16 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.data io.directories.unix kernel libc 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 IN: io.directories.unix.linux
M: linux find-next-file ( DIR* -- dirent ) : next-dirent ( DIR* dirent* -- dirent* ? )
dirent <struct> f void* <ref> [
f void* <ref> readdir64_r [ dup strerror libc-error ] unless-zero
[ [ readdir64_r ] unix-system-call 0 = [ (io-error) ] unless ] 2keep ] 2keep void* deref ; inline
void* deref [ drop f ] unless ;
M: linux (directory-entries) ( path -- seq )
[
dirent <struct>
'[ _ _ next-dirent ] [ >directory-entry ] produce nip
] with-unix-directory ;

View File

@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.data alien.strings
assocs combinators continuations destructors fry io io.backend assocs combinators continuations destructors fry io io.backend
io.directories io.encodings.binary io.files.info.unix io.directories io.encodings.binary io.files.info.unix
io.encodings.utf8 io.files io.pathnames io.files.types kernel 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 ; classes.struct unix.ffi literals libc vocabs io.files.info ;
IN: io.directories.unix IN: io.directories.unix
@ -40,15 +40,6 @@ M: unix copy-file ( from to -- )
dupd curry swap '[ _ closedir io-error ] [ ] cleanup dupd curry swap '[ _ closedir io-error ] [ ] cleanup
] with-directory ; inline ] 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 ) : dirent-type>file-type ( type -- file-type )
H{ H{
{ $ DT_BLK +block-device+ } { $ 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 ! An easy way to return +unknown+ is to mount a .iso on OSX and
! call directory-entries on the mount point. ! 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 ) : next-dirent ( DIR* dirent* -- dirent* ? )
{ f void* <ref> [
[ d_name>> underlying>> utf8 alien>string ] readdir_r [ dup strerror libc-error ] unless-zero
[ dirent>file-type ] ] 2keep void* deref ; inline
} cleave directory-entry boa ;
: >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 ) M: unix (directory-entries) ( path -- seq )
[ [
'[ _ find-next-file dup ] dirent <struct>
[ >directory-entry ] '[ _ _ next-dirent ] [ >directory-entry ] produce nip
produce nip
] with-unix-directory ; ] with-unix-directory ;
os linux? [ "io.directories.unix.linux" require ] when os linux? [ "io.directories.unix.linux" require ] when

View File

@ -48,13 +48,11 @@ M: windows delete-directory ( path -- )
normalize-path normalize-path
RemoveDirectory win32-error=0/f ; RemoveDirectory win32-error=0/f ;
: find-first-file ( path -- WIN32_FIND_DATA handle ) : find-first-file ( path WIN32_FIND_DATA -- WIN32_FIND_DATA HANDLE )
WIN32_FIND_DATA <struct>
[ nip ] [ FindFirstFile ] 2bi [ nip ] [ FindFirstFile ] 2bi
[ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ; [ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ;
: find-next-file ( path -- WIN32_FIND_DATA/f ) : find-next-file ( HANDLE WIN32_FIND_DATA -- WIN32_FIND_DATA/f )
WIN32_FIND_DATA <struct>
[ nip ] [ FindNextFile ] 2bi 0 = [ [ nip ] [ FindNextFile ] 2bi 0 = [
GetLastError ERROR_NO_MORE_FILES = [ GetLastError ERROR_NO_MORE_FILES = [
win32-error win32-error
@ -63,23 +61,27 @@ M: windows delete-directory ( path -- )
TUPLE: windows-directory-entry < directory-entry attributes ; 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 ] [ cFileName>> alien>native-string ]
[ [
dwFileAttributes>> dwFileAttributes>>
[ win32-file-type ] [ win32-file-attributes ] bi [ win32-file-type ] [ win32-file-attributes ] bi
] bi ] bi
dupd remove windows-directory-entry boa ; dupd remove <windows-directory-entry> ; inline
M: windows (directory-entries) ( path -- seq ) M: windows (directory-entries) ( path -- seq )
"\\" ?tail drop "\\*" append "\\" ?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 ] [ _ _ find-next-file dup ]
[ >directory-entry ] [ >windows-directory-entry ]
produce nip produce nip
over name>> "." = [ nip ] [ swap prefix ] if over name>> "." = [ nip ] [ swap prefix ] if
] ]
] [ '[ _ FindClose win32-error=0/f ] ] bi [ ] cleanup ; ] [ drop '[ _ FindClose win32-error=0/f ] ] 2bi [ ] cleanup ;