From 83638c35dabc6e1c0b683470c14dd8a90bb32ed0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 12:55:48 -0500 Subject: [PATCH 01/35] change up the way you read directories --- core/io/files/files-docs.factor | 30 ++++++++++------------- core/io/files/files-tests.factor | 14 +++++++---- core/io/files/files.factor | 41 ++++++++++++++++---------------- 3 files changed, 44 insertions(+), 41 deletions(-) diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index 8e32c100e0..984598688d 100644 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -55,8 +55,9 @@ ARTICLE: "directories" "Directories" "Home directory:" { $subsection home } "Directory listing:" -{ $subsection directory } -{ $subsection directory* } +{ $subsection directory-entries } +{ $subsection directory-files } +{ $subsection with-directory-files } "Creating directories:" { $subsection make-directory } { $subsection make-directories } @@ -304,23 +305,22 @@ HELP: directory? { $values { "file-info" file-info } { "?" "a boolean" } } { $description "Tests if " { $snippet "file-info" } " is a directory." } ; -HELP: (directory) +HELP: (directory-entries) { $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } } { $description "Outputs the contents of a directory named by " { $snippet "path" } "." } -{ $notes "This is a low-level word, and user code should call " { $link directory } " instead." } ; +{ $notes "This is a low-level word, and user code should call one of the related words instead." } ; -HELP: directory -{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } } +HELP: directory-entries +{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $link directory-entry } " objects" } } { $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ; -HELP: directory* -{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ path dir? }" } " pairs" } } -{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } -{ $notes "Unlike " { $link directory } ", this word prepends the directory's path to all file names in the list." } ; +HELP: directory-files +{ $values { "path" "a pathname string" } { "seq" "a sequence of filenames" } } +{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ; -! HELP: file-modified -! { $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } } -! { $description "Outputs a file's last modification time, since midnight January 1, 1970. If the file does not exist, outputs " { $link f } "." } ; +HELP: with-directory-files +{ $values { "path" "a pathname string" } { "quot" quotation } } +{ $description "Calls the quotation with the directory file names on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ; HELP: resource-path { $values { "path" "a pathname string" } { "newpath" "a pathname string" } } @@ -329,10 +329,6 @@ HELP: resource-path HELP: pathname { $class-description "Class of path name objects. Path name objects can be created by calling " { $link } "." } ; -HELP: normalize-directory -{ $values { "str" "a pathname string" } { "newstr" "a new pathname string" } } -{ $description "Called by the " { $link directory } " word to prepare a pathname before passing it to the " { $link (directory) } " primitive." } ; - HELP: normalize-path { $values { "str" "a pathname string" } { "newstr" "a new pathname string" } } { $description "Called by words such as " { $link } " and " { $link } " to prepare a pathname before passing it to underlying code." } ; diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 0723096519..3104fcdb55 100644 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -151,18 +151,24 @@ USE: debugger.threads "delete-tree-test" temp-file delete-tree ] unit-test -[ { { "kernel" t } } ] [ +[ { "kernel" } ] [ "core" resource-path [ - "." directory [ first "kernel" = ] filter + "." directory-files [ "kernel" = ] filter ] with-directory ] unit-test -[ { { "kernel" t } } ] [ +[ { "kernel" } ] [ "resource:core" [ - "." directory [ first "kernel" = ] filter + "." directory-files [ "kernel" = ] filter ] with-directory ] unit-test +[ { "kernel" } ] [ + "resource:core" [ + [ "kernel" = ] filter + ] with-directory-files +] unit-test + [ ] [ "copy-tree-test/a/b/c" temp-file make-directories ] unit-test diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 6b84073d34..8796834bc7 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -235,19 +235,22 @@ HOOK: make-directory io-backend ( path -- ) ] } cond drop ; -! Directory listings -: fixup-directory ( path seq -- newseq ) - [ - dup string? - [ tuck append-path file-info directory? 2array ] [ nip ] if - ] with map - [ first { "." ".." } member? not ] filter ; +TUPLE: directory-entry name type ; -: directory ( path -- seq ) - normalize-directory dup (directory) fixup-directory ; +HOOK: >directory-entry os ( byte-array -- directory-entry ) -: directory* ( path -- seq ) - dup directory [ first2 >r append-path r> 2array ] with map ; +HOOK: (directory-entries) os ( path -- seq ) + +: directory-entries ( path -- seq ) + normalize-path + (directory-entries) + [ name>> { "." ".." } member? not ] filter ; + +: directory-files ( path -- seq ) + directory-entries [ name>> ] map ; + +: with-directory-files ( path quot -- ) + [ "" directory-files ] prepose with-directory ; inline ! Touching files HOOK: touch-file io-backend ( path -- ) @@ -259,12 +262,10 @@ HOOK: delete-directory io-backend ( path -- ) : delete-tree ( path -- ) dup link-info type>> +directory+ = [ - dup directory over [ - [ first delete-tree ] each - ] with-directory delete-directory - ] [ - delete-file - ] if ; + [ [ [ delete-tree ] each ] with-directory-files ] + [ delete-directory ] + bi + ] [ delete-file ] if ; : to-directory ( from to -- from to' ) over file-name append-path ; @@ -303,9 +304,9 @@ DEFER: copy-tree-into { { +symbolic-link+ [ copy-link ] } { +directory+ [ - >r dup directory r> rot [ - [ >r first r> copy-tree-into ] curry each - ] with-directory + swap [ + [ swap copy-tree-into ] with each + ] with-directory-files ] } [ drop copy-file ] } case ; From 0e9ecc1ba9d77f49a3205001349678610d1cac5b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 13:09:48 -0500 Subject: [PATCH 02/35] directory changes --- basis/http/server/static/static.factor | 6 ++--- basis/io/monitors/recursive/recursive.factor | 6 +++-- basis/io/unix/files/files.factor | 23 +++++++++++++++++- basis/unix/unix.factor | 5 ++++ extra/shell/shell.factor | 2 +- extra/webapps/wiki/wiki.factor | 25 ++++++++++---------- 6 files changed, 48 insertions(+), 19 deletions(-) diff --git a/basis/http/server/static/static.factor b/basis/http/server/static/static.factor index 3e3307033a..3edcfe81cd 100644 --- a/basis/http/server/static/static.factor +++ b/basis/http/server/static/static.factor @@ -59,8 +59,8 @@ TUPLE: file-responder root hook special allow-listings ; \ serve-file NOTICE add-input-logging -: file. ( name dirp -- ) - [ "/" append ] when +: file. ( name -- ) + dup link-info directory? [ "/" append ] when dup escape-string write ; : directory. ( path -- ) @@ -68,7 +68,7 @@ TUPLE: file-responder root hook special allow-listings ; [

file-name escape-string write

] [
    - directory sort-keys + directory-files [
  • file.
    • ] assoc-each
] bi diff --git a/basis/io/monitors/recursive/recursive.factor b/basis/io/monitors/recursive/recursive.factor index 383e166214..3cecee2b1e 100644 --- a/basis/io/monitors/recursive/recursive.factor +++ b/basis/io/monitors/recursive/recursive.factor @@ -19,11 +19,13 @@ DEFER: add-child-monitor : add-child-monitors ( path -- ) #! We yield since this directory scan might take a while. - directory* [ first add-child-monitor ] each yield ; + [ + [ add-child-monitor ] each yield + ] with-directory-files ; : add-child-monitor ( path -- ) notify? [ dup { +add-file+ } monitor tget queue-change ] when - qualify-path dup link-info type>> +directory+ eq? [ + qualify-path dup link-info directory? [ [ add-child-monitors ] [ [ diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor index af023e3f13..67da640b71 100644 --- a/basis/io/unix/files/files.factor +++ b/basis/io/unix/files/files.factor @@ -6,7 +6,7 @@ math.bitwise byte-arrays alien combinators calendar io.encodings.binary accessors sequences strings system io.files.private destructors vocabs.loader calendar.unix unix.stat alien.c-types arrays unix.users unix.groups -environment ; +environment fry io.encodings.utf8 alien.strings ; IN: io.unix.files M: unix cwd ( -- path ) @@ -138,6 +138,27 @@ os { { linux [ ] } } case +: with-unix-directory ( path quot -- ) + [ opendir dup [ (io-error) ] unless ] dip + dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline + +: find-next-file ( DIR* -- byte-array ) + "dirent" + f + [ readdir_r 0 = [ (io-error) ] unless ] 2keep + *void* [ drop f ] unless ; + +M: unix >directory-entry ( byte-array -- directory-entry ) + [ dirent-d_name utf8 alien>string ] + [ dirent-d_type ] bi directory-entry boa ; + +M: unix (directory-entries) ( path -- seq ) + [ + '[ _ find-next-file dup ] + [ >directory-entry ] + [ drop ] produce + ] with-unix-directory ; + > os-env ; METHOD: expand { glob-expr } expr>> dup "*" = - [ drop current-directory get directory [ first ] map ] + [ drop current-directory get directory-files ] [ ] if ; diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor index 16c51a876b..b833cc8cc2 100644 --- a/extra/webapps/wiki/wiki.factor +++ b/extra/webapps/wiki/wiki.factor @@ -374,15 +374,16 @@ M: revision feed-entry-url id>> revision-url ; { wiki "wiki-common" } >>template ; : init-wiki ( -- ) - "resource:extra/webapps/wiki/initial-content" directory* keys - [ - dup file-name ".txt" ?tail [ - swap ascii file-contents - f - swap >>content - swap >>title - "slava" >>author - now >>date - add-revision - ] [ 2drop ] if - ] each ; + "resource:extra/webapps/wiki/initial-content" [ + [ + dup ".txt" ?tail [ + swap ascii file-contents + f + swap >>content + swap >>title + "slava" >>author + now >>date + add-revision + ] [ 2drop ] if + ] each + ] with-directory-files ; From 613cd3fd67ce1d02751dcb1e5511e134c3020662 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 13:10:28 -0500 Subject: [PATCH 03/35] directory/stat struct work --- basis/unix/bsd/macosx/macosx.factor | 37 +++++++++ basis/unix/stat/macosx/macosx.factor | 120 ++++++++++++++++++++++++++- basis/unix/stat/stat.factor | 8 +- 3 files changed, 158 insertions(+), 7 deletions(-) diff --git a/basis/unix/bsd/macosx/macosx.factor b/basis/unix/bsd/macosx/macosx.factor index c41ae6df7d..96e2cde163 100644 --- a/basis/unix/bsd/macosx/macosx.factor +++ b/basis/unix/bsd/macosx/macosx.factor @@ -132,3 +132,40 @@ C-STRUCT: utmpx { "timeval" "ut_tv" } { { "char" _UTX_HOSTSIZE } "ut_host" } { { "uint" 16 } "ut_pad" } ; + +: __PTHREAD_MUTEX_SIZE__ 40 ; inline + +C-STRUCT: _opaque_pthread_mutex_t + { "long" "__sig" } + { { "char" __PTHREAD_MUTEX_SIZE__ } "__opaque" } ; + +TYPEDEF: _opaque_pthread_mutex_t* __darwin_pthread_mutex_t + +C-STRUCT: DIR + { "int" "__dd_fd" } + { "long" "__dd_loc" } + { "long" "__dd_size" } + { "char*" "__dd_buf" } + { "int" "__dd_len" } + { "long" "__dd_seek" } + { "long" "__dd_rewind" } + { "int" "__dd_flags" } + { "__darwin_pthread_mutex_t" "__dd_lock" } + { "void*" "__dd_td" } ; + + +! #define DIRSIZ(dp) \ + ! ((sizeof (struct direct) - (MAXNAMLEN+1)) + (((dp)->d_namlen+1 + 3) &~ 3)) + +! __DARWIN_STRUCT_DIRENTRY { \ + +: __DARWIN_MAXPATHLEN 1024 ; inline +: __DARWIN_MAXNAMELEN 255 ; inline +: __DARWIN_MAXNAMELEN+1 255 ; inline + +C-STRUCT: dirent + { "ino_t" "d_ino" } + { "__uint16_t" "d_reclen" } + { "__uint8_t" "d_type" } + { "__uint8_t" "d_namlen" } + { { "char" __DARWIN_MAXNAMELEN+1 } "d_name" } ; diff --git a/basis/unix/stat/macosx/macosx.factor b/basis/unix/stat/macosx/macosx.factor index b2574b474d..03301d25b9 100644 --- a/basis/unix/stat/macosx/macosx.factor +++ b/basis/unix/stat/macosx/macosx.factor @@ -1,4 +1,5 @@ -USING: kernel alien.syntax math ; +USING: kernel alien.syntax math unix math.bitwise +alien.c-types alien sequences grouping accessors combinators ; IN: unix.stat ! Mac OS X ppc @@ -30,3 +31,120 @@ FUNCTION: int lstat64 ( char* pathname, stat* buf ) ; : stat ( path buf -- n ) stat64 ; : lstat ( path buf -- n ) lstat64 ; + +: MNT_RDONLY HEX: 00000001 ; inline +: MNT_SYNCHRONOUS HEX: 00000002 ; inline +: MNT_NOEXEC HEX: 00000004 ; inline +: MNT_NOSUID HEX: 00000008 ; inline +: MNT_NODEV HEX: 00000010 ; inline +: MNT_UNION HEX: 00000020 ; inline +: MNT_ASYNC HEX: 00000040 ; inline +: MNT_EXPORTED HEX: 00000100 ; inline +: MNT_QUARANTINE HEX: 00000400 ; inline +: MNT_LOCAL HEX: 00001000 ; inline +: MNT_QUOTA HEX: 00002000 ; inline +: MNT_ROOTFS HEX: 00004000 ; inline +: MNT_DOVOLFS HEX: 00008000 ; inline +: MNT_DONTBROWSE HEX: 00100000 ; inline +: MNT_IGNORE_OWNERSHIP HEX: 00200000 ; inline +: MNT_AUTOMOUNTED HEX: 00400000 ; inline +: MNT_JOURNALED HEX: 00800000 ; inline +: MNT_NOUSERXATTR HEX: 01000000 ; inline +: MNT_DEFWRITE HEX: 02000000 ; inline +: MNT_MULTILABEL HEX: 04000000 ; inline +: MNT_NOATIME HEX: 10000000 ; inline +: MNT_UNKNOWNPERMISSIONS MNT_IGNORE_OWNERSHIP ; inline + +: MNT_VISFLAGMASK ( -- n ) + { + MNT_RDONLY MNT_SYNCHRONOUS MNT_NOEXEC + MNT_NOSUID MNT_NODEV MNT_UNION + MNT_ASYNC MNT_EXPORTED MNT_QUARANTINE + MNT_LOCAL MNT_QUOTA + MNT_ROOTFS MNT_DOVOLFS MNT_DONTBROWSE + MNT_IGNORE_OWNERSHIP MNT_AUTOMOUNTED MNT_JOURNALED + MNT_NOUSERXATTR MNT_DEFWRITE MNT_MULTILABEL MNT_NOATIME + } flags ; inline + +: MNT_UPDATE HEX: 00010000 ; inline +: MNT_RELOAD HEX: 00040000 ; inline +: MNT_FORCE HEX: 00080000 ; inline +: MNT_CMDFLAGS { MNT_UPDATE MNT_RELOAD MNT_FORCE } flags ; inline + +: VFS_GENERIC 0 ; inline +: VFS_NUMMNTOPS 1 ; inline +: VFS_MAXTYPENUM 1 ; inline +: VFS_CONF 2 ; inline +: VFS_SET_PACKAGE_EXTS 3 ; inline + +: MNT_WAIT 1 ; inline +: MNT_NOWAIT 2 ; inline + +: VFS_CTL_VERS1 HEX: 01 ; inline + +: VFS_CTL_STATFS HEX: 00010001 ; inline +: VFS_CTL_UMOUNT HEX: 00010002 ; inline +: VFS_CTL_QUERY HEX: 00010003 ; inline +: VFS_CTL_NEWADDR HEX: 00010004 ; inline +: VFS_CTL_TIMEO HEX: 00010005 ; inline +: VFS_CTL_NOLOCKS HEX: 00010006 ; inline + +C-STRUCT: vfsquery + { "uint32_t" "vq_flags" } + { { "uint32_t" 31 } "vq_spare" } ; + +: VQ_NOTRESP HEX: 0001 ; inline +: VQ_NEEDAUTH HEX: 0002 ; inline +: VQ_LOWDISK HEX: 0004 ; inline +: VQ_MOUNT HEX: 0008 ; inline +: VQ_UNMOUNT HEX: 0010 ; inline +: VQ_DEAD HEX: 0020 ; inline +: VQ_ASSIST HEX: 0040 ; inline +: VQ_NOTRESPLOCK HEX: 0080 ; inline +: VQ_UPDATE HEX: 0100 ; inline +: VQ_FLAG0200 HEX: 0200 ; inline +: VQ_FLAG0400 HEX: 0400 ; inline +: VQ_FLAG0800 HEX: 0800 ; inline +: VQ_FLAG1000 HEX: 1000 ; inline +: VQ_FLAG2000 HEX: 2000 ; inline +: VQ_FLAG4000 HEX: 4000 ; inline +: VQ_FLAG8000 HEX: 8000 ; inline + +: NFSV4_MAX_FH_SIZE 128 ; inline +: NFSV3_MAX_FH_SIZE 64 ; inline +: NFSV2_MAX_FH_SIZE 32 ; inline +: NFS_MAX_FH_SIZE NFSV4_MAX_FH_SIZE ; inline + +! C-STRUCT: fhandle + ! { "int" "fh_len" } + ! { { "uchar" NFS_MAX_FH_SIZE } "fh_data" } ; + +! TYPEDEF: fhandle fhandle_t + +: MFSNAMELEN 15 ; inline +: MNAMELEN 90 ; inline +: MFSTYPENAMELEN 16 ; inline + +C-STRUCT: fsid_t + { { "int32_t" 2 } "val" } ; + +C-STRUCT: statfs64 + { "uint32_t" "f_bsize" } + { "int32_t" "f_iosize" } + { "uint64_t" "f_blocks" } + { "uint64_t" "f_bfree" } + { "uint64_t" "f_bavail" } + { "uint64_t" "f_files" } + { "uint64_t" "f_ffree" } + { "fsid_t" "f_fsid" } + { "uid_t" "f_owner" } + { "uint32_t" "f_type" } + { "uint32_t" "f_flags" } + { "uint32_t" "f_fssubtype" } + { { "char" MFSTYPENAMELEN } "f_fstypename" } + { { "char" MAXPATHLEN } "f_mntonname" } + { { "char" MAXPATHLEN } "f_mntfromname" } + { { "uint32_t" 8 } "f_reserved" } ; + +FUNCTION: int statfs64 ( char* path, statfs64* buf ) ; +FUNCTION: int getmntinfo64 ( statfs64** mntbufp, int flags ) ; diff --git a/basis/unix/stat/stat.factor b/basis/unix/stat/stat.factor index 46fe7d98f9..f8ad74c213 100644 --- a/basis/unix/stat/stat.factor +++ b/basis/unix/stat/stat.factor @@ -27,11 +27,7 @@ FUNCTION: int mkdir ( char* path, mode_t mode ) ; } case >> : file-status ( pathname -- stat ) - "stat" [ - [ stat ] unix-system-call drop - ] keep ; + "stat" [ [ stat ] unix-system-call drop ] keep ; : link-status ( pathname -- stat ) - "stat" [ - [ lstat ] unix-system-call drop - ] keep ; + "stat" [ [ lstat ] unix-system-call drop ] keep ; From 4af3543fcda176a5f930c7d644c2a1689033aa28 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 13:11:10 -0500 Subject: [PATCH 04/35] directory fix --- extra/io/paths/paths.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/io/paths/paths.factor b/extra/io/paths/paths.factor index 58b3518edd..8237e59a1b 100755 --- a/extra/io/paths/paths.factor +++ b/extra/io/paths/paths.factor @@ -7,7 +7,7 @@ IN: io.paths TUPLE: directory-iterator path bfs queue ; : qualified-directory ( path -- seq ) - dup directory [ first2 [ append-path ] dip 2array ] with map ; + dup directory-files [ append-path ] with map ; : push-directory ( path iter -- ) [ qualified-directory ] dip [ @@ -21,7 +21,7 @@ TUPLE: directory-iterator path bfs queue ; : next-file ( iter -- file/f ) dup queue>> deque-empty? [ drop f ] [ - dup queue>> pop-back first2 + dup queue>> pop-back dup link-info directory? [ over push-directory next-file ] [ nip ] if ] if ; From 78a529b1c315c7c6c849784847524591eb015de1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 13:27:59 -0500 Subject: [PATCH 05/35] remove directory from the vm --- .../known-words/known-words.factor | 2 - basis/tools/vocabs/vocabs.factor | 7 +-- core/bootstrap/primitives.factor | 1 - vm/os-unix.c | 38 ---------------- vm/os-windows.c | 43 ------------------- vm/primitives.c | 1 - 6 files changed, 4 insertions(+), 88 deletions(-) diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 1a0f3c5eb2..1332415c49 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -396,8 +396,6 @@ do-primitive alien-invoke alien-indirect alien-callback \ (exists?) { string } { object } define-primitive -\ (directory) { string } { array } define-primitive - \ gc { } { } define-primitive \ gc-stats { } { array } define-primitive diff --git a/basis/tools/vocabs/vocabs.factor b/basis/tools/vocabs/vocabs.factor index 732a6635b7..05f354a8a8 100644 --- a/basis/tools/vocabs/vocabs.factor +++ b/basis/tools/vocabs/vocabs.factor @@ -14,8 +14,7 @@ IN: tools.vocabs : vocab-tests-dir ( vocab -- paths ) dup vocab-dir "tests" append-path vocab-append-path dup [ dup exists? [ - dup directory keys - [ ".factor" tail? ] filter + dup directory-files [ ".factor" tail? ] filter [ append-path ] with map ] [ drop f ] if ] [ drop f ] if ; @@ -208,7 +207,9 @@ M: vocab-link summary vocab-summary ; dup vocab-authors-path set-vocab-file-contents ; : subdirs ( dir -- dirs ) - directory [ second ] filter keys natural-sort ; + [ + [ link-info directory? ] filter + ] with-directory-files natural-sort ; : (all-child-vocabs) ( root name -- vocabs ) [ vocab-dir append-path subdirs ] keep diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 08ae762577..62d4ec9273 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -434,7 +434,6 @@ tuple { "getenv" "kernel.private" } { "setenv" "kernel.private" } { "(exists?)" "io.files.private" } - { "(directory)" "io.files.private" } { "gc" "memory" } { "gc-stats" "memory" } { "save-image" "memory" } diff --git a/vm/os-unix.c b/vm/os-unix.c index fa2d5bb40c..4ca62e6623 100755 --- a/vm/os-unix.c +++ b/vm/os-unix.c @@ -61,44 +61,6 @@ DEFINE_PRIMITIVE(existsp) box_boolean(stat(unbox_char_string(),&sb) >= 0); } -/* Allocates memory */ -CELL parse_dir_entry(struct dirent *file) -{ - CELL name = tag_object(from_char_string(file->d_name)); - if(UNKNOWN_TYPE_P(file)) - return name; - else - { - CELL dirp = tag_boolean(DIRECTORY_P(file)); - return allot_array_2(name,dirp); - } -} - -DEFINE_PRIMITIVE(read_dir) -{ - DIR* dir = opendir(unbox_char_string()); - GROWABLE_ARRAY(result); - REGISTER_ROOT(result); - - if(dir != NULL) - { - struct dirent* file; - - while((file = readdir(dir)) != NULL) - { - CELL pair = parse_dir_entry(file); - GROWABLE_ARRAY_ADD(result,pair); - } - - closedir(dir); - } - - UNREGISTER_ROOT(result); - GROWABLE_ARRAY_TRIM(result); - - dpush(result); -} - F_SEGMENT *alloc_segment(CELL size) { int pagesize = getpagesize(); diff --git a/vm/os-windows.c b/vm/os-windows.c index c36ba59a27..c19aa5c4b5 100755 --- a/vm/os-windows.c +++ b/vm/os-windows.c @@ -87,21 +87,6 @@ const F_CHAR *vm_executable_path(void) return safe_strdup(full_path); } -void find_file_stat(F_CHAR *path) -{ - // FindFirstFile is the only call that can stat c:\pagefile.sys - WIN32_FIND_DATA st; - HANDLE h; - - if(INVALID_HANDLE_VALUE == (h = FindFirstFile(path, &st))) - dpush(F); - else - { - FindClose(h); - dpush(T); - } -} - DEFINE_PRIMITIVE(existsp) { BY_HANDLE_FILE_INFORMATION bhfi; @@ -136,34 +121,6 @@ DEFINE_PRIMITIVE(existsp) CloseHandle(h); } -DEFINE_PRIMITIVE(read_dir) -{ - HANDLE dir; - WIN32_FIND_DATA find_data; - F_CHAR *path = unbox_u16_string(); - - GROWABLE_ARRAY(result); - REGISTER_ROOT(result); - - if(INVALID_HANDLE_VALUE != (dir = FindFirstFile(path, &find_data))) - { - do - { - CELL name = tag_object(from_u16_string(find_data.cFileName)); - CELL dirp = tag_boolean(find_data.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY); - CELL pair = allot_array_2(name,dirp); - GROWABLE_ARRAY_ADD(result,pair); - } - while (FindNextFile(dir, &find_data)); - FindClose(dir); - } - - UNREGISTER_ROOT(result); - GROWABLE_ARRAY_TRIM(result); - - dpush(result); -} - F_SEGMENT *alloc_segment(CELL size) { char *mem; diff --git a/vm/primitives.c b/vm/primitives.c index 39dc2b10d7..94151f6c40 100755 --- a/vm/primitives.c +++ b/vm/primitives.c @@ -57,7 +57,6 @@ void *primitives[] = { primitive_getenv, primitive_setenv, primitive_existsp, - primitive_read_dir, primitive_gc, primitive_gc_stats, primitive_save_image, From a71ca7242a660bb0c6664df8e2d619a583f1cd93 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 13:34:00 -0500 Subject: [PATCH 06/35] fix typo in docs, fix load error --- basis/io/windows/files/unique/unique.factor | 2 +- core/sequences/sequences-docs.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/windows/files/unique/unique.factor b/basis/io/windows/files/unique/unique.factor index dcb713df7f..b1bf2bdc1c 100644 --- a/basis/io/windows/files/unique/unique.factor +++ b/basis/io/windows/files/unique/unique.factor @@ -1,6 +1,6 @@ USING: kernel system io.files.unique.backend windows.kernel32 io.windows io.windows.files io.ports windows -destructors ; +destructors environment ; IN: io.windows.files.unique M: windows (make-unique-file) ( path -- ) diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index fc6f1465bb..a75b97c040 100644 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -398,7 +398,7 @@ HELP: filter { $description "Applies the quotation to each element in turn, and outputs a new sequence containing the elements of the original sequence for which the quotation output a true value." } ; HELP: filter-here -{ $values { "seq" "a resizable mutable sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "subseq" "a new sequence" } } +{ $values { "seq" "a resizable mutable sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } } { $description "Applies the quotation to each element in turn, and removes elements for which the quotation outputs a false value." } { $side-effects "seq" } ; From bce8b1eff617da9a9c8e47a8938823e1d2326500 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 13:43:42 -0500 Subject: [PATCH 07/35] DIR is not meant to be explicit --- basis/unix/bsd/macosx/macosx.factor | 18 ------------------ basis/unix/unix.factor | 2 +- 2 files changed, 1 insertion(+), 19 deletions(-) diff --git a/basis/unix/bsd/macosx/macosx.factor b/basis/unix/bsd/macosx/macosx.factor index 96e2cde163..6270dc53b1 100644 --- a/basis/unix/bsd/macosx/macosx.factor +++ b/basis/unix/bsd/macosx/macosx.factor @@ -141,24 +141,6 @@ C-STRUCT: _opaque_pthread_mutex_t TYPEDEF: _opaque_pthread_mutex_t* __darwin_pthread_mutex_t -C-STRUCT: DIR - { "int" "__dd_fd" } - { "long" "__dd_loc" } - { "long" "__dd_size" } - { "char*" "__dd_buf" } - { "int" "__dd_len" } - { "long" "__dd_seek" } - { "long" "__dd_rewind" } - { "int" "__dd_flags" } - { "__darwin_pthread_mutex_t" "__dd_lock" } - { "void*" "__dd_td" } ; - - -! #define DIRSIZ(dp) \ - ! ((sizeof (struct direct) - (MAXNAMLEN+1)) + (((dp)->d_namlen+1 + 3) &~ 3)) - -! __DARWIN_STRUCT_DIRENTRY { \ - : __DARWIN_MAXPATHLEN 1024 ; inline : __DARWIN_MAXNAMELEN 255 ; inline : __DARWIN_MAXNAMELEN+1 255 ; inline diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index ab49cd3f45..d7af214a49 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -160,7 +160,7 @@ FUNCTION: int pipe ( int* filedes ) ; FUNCTION: void* popen ( char* command, char* type ) ; FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ; -FUNCTION: int readdir_r ( DIR* dirp, dirent* entry, dirent** result ) ; +FUNCTION: int readdir_r ( void* dirp, dirent* entry, dirent** result ) ; FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ; From 548ee091d986ecf060ecc2ac07d892c84d1fb15c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 14:21:12 -0500 Subject: [PATCH 08/35] ffi work, add dirent struct for linux --- basis/unix/bsd/bsd.factor | 2 -- basis/unix/linux/fs/fs.factor | 4 +--- basis/unix/linux/linux.factor | 7 +++++++ basis/unix/stat/linux/linux.factor | 7 ++----- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/basis/unix/bsd/bsd.factor b/basis/unix/bsd/bsd.factor index 7bbf2b4fdf..bf426ad867 100644 --- a/basis/unix/bsd/bsd.factor +++ b/basis/unix/bsd/bsd.factor @@ -3,8 +3,6 @@ USING: alien.syntax combinators system vocabs.loader ; IN: unix -! FreeBSD - : MAXPATHLEN 1024 ; inline : O_RDONLY HEX: 0000 ; inline diff --git a/basis/unix/linux/fs/fs.factor b/basis/unix/linux/fs/fs.factor index 475d0290a6..6cb9f68934 100644 --- a/basis/unix/linux/fs/fs.factor +++ b/basis/unix/linux/fs/fs.factor @@ -1,6 +1,4 @@ - USING: alien.syntax ; - IN: unix.linux.fs : MS_RDONLY 1 ; ! Mount read-only. @@ -22,4 +20,4 @@ FUNCTION: int mount ! FUNCTION: int umount2 ( char* file, int flags ) ; -FUNCTION: int umount ( char* file ) ; \ No newline at end of file +FUNCTION: int umount ( char* file ) ; diff --git a/basis/unix/linux/linux.factor b/basis/unix/linux/linux.factor index 457d96c7d8..7a77dc9316 100644 --- a/basis/unix/linux/linux.factor +++ b/basis/unix/linux/linux.factor @@ -92,6 +92,13 @@ C-STRUCT: passwd { "char*" "pw_dir" } { "char*" "pw_shell" } ; +C-STRUCT: dirent + { "__ino_t" "d_ino" } + { "__off_t" "d_off" } + { "ushort" "d_reclen" } + { "uchar" "d_type" } + { { "char" 256 } "d_name" } ; + : EPERM 1 ; inline : ENOENT 2 ; inline : ESRCH 3 ; inline diff --git a/basis/unix/stat/linux/linux.factor b/basis/unix/stat/linux/linux.factor index 2f4b6174d9..1df6865d41 100644 --- a/basis/unix/stat/linux/linux.factor +++ b/basis/unix/stat/linux/linux.factor @@ -1,11 +1,8 @@ - USING: layouts combinators vocabs.loader ; - IN: unix.stat cell-bits - { +{ { 32 [ "unix.stat.linux.32" require ] } { 64 [ "unix.stat.linux.64" require ] } - } -case +} case From cc1365390a54c56b7ad248b0e4e3e1f6bb53fca5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 14:33:45 -0500 Subject: [PATCH 09/35] dirent and type definitions --- basis/unix/bsd/freebsd/freebsd.factor | 17 +++++++ basis/unix/bsd/macosx/macosx.factor | 71 ++++++++++++++------------- basis/unix/bsd/netbsd/netbsd.factor | 17 +++++++ basis/unix/bsd/openbsd/openbsd.factor | 18 +++++++ 4 files changed, 89 insertions(+), 34 deletions(-) diff --git a/basis/unix/bsd/freebsd/freebsd.factor b/basis/unix/bsd/freebsd/freebsd.factor index 34f0f0429c..3af6358e94 100644 --- a/basis/unix/bsd/freebsd/freebsd.factor +++ b/basis/unix/bsd/freebsd/freebsd.factor @@ -13,6 +13,23 @@ C-STRUCT: addrinfo { "void*" "addr" } { "addrinfo*" "next" } ; +C-STRUCT: dirent + { "u_int32_t" "d_fileno" } + { "u_int16_t" "d_reclen" } + { "u_int8_t" "d_type" } + { "u_int8_t" "d_namlen" } + { { "char" 256 } "d_name" } ; + +: DT_UNKNOWN 0 ; inline +: DT_FIFO 1 ; inline +: DT_CHR 2 ; inline +: DT_DIR 4 ; inline +: DT_BLK 6 ; inline +: DT_REG 8 ; inline +: DT_LNK 10 ; inline +: DT_SOCK 12 ; inline +: DT_WHT 14 ; inline + : EPERM 1 ; inline : ENOENT 2 ; inline : ESRCH 3 ; inline diff --git a/basis/unix/bsd/macosx/macosx.factor b/basis/unix/bsd/macosx/macosx.factor index 6270dc53b1..de2fd4caf0 100644 --- a/basis/unix/bsd/macosx/macosx.factor +++ b/basis/unix/bsd/macosx/macosx.factor @@ -13,6 +13,43 @@ C-STRUCT: addrinfo { "void*" "addr" } { "addrinfo*" "next" } ; +: _UTX_USERSIZE 256 ; inline +: _UTX_LINESIZE 32 ; inline +: _UTX_IDSIZE 4 ; inline +: _UTX_HOSTSIZE 256 ; inline + +C-STRUCT: utmpx + { { "char" _UTX_USERSIZE } "ut_user" } + { { "char" _UTX_IDSIZE } "ut_id" } + { { "char" _UTX_LINESIZE } "ut_line" } + { "pid_t" "ut_pid" } + { "short" "ut_type" } + { "timeval" "ut_tv" } + { { "char" _UTX_HOSTSIZE } "ut_host" } + { { "uint" 16 } "ut_pad" } ; + +: __DARWIN_MAXPATHLEN 1024 ; inline +: __DARWIN_MAXNAMELEN 255 ; inline +: __DARWIN_MAXNAMELEN+1 255 ; inline + +C-STRUCT: dirent + { "ino_t" "d_ino" } + { "__uint16_t" "d_reclen" } + { "__uint8_t" "d_type" } + { "__uint8_t" "d_namlen" } + { { "char" __DARWIN_MAXNAMELEN+1 } "d_name" } ; + +: DT_UNKNOWN 0 ; inline +: DT_FIFO 1 ; inline +: DT_CHR 2 ; inline +: DT_DIR 4 ; inline +: DT_BLK 6 ; inline +: DT_REG 8 ; inline +: DT_LNK 10 ; inline +: DT_SOCK 12 ; inline +: DT_WHT 14 ; inline + + : EPERM 1 ; inline : ENOENT 2 ; inline : ESRCH 3 ; inline @@ -117,37 +154,3 @@ C-STRUCT: addrinfo : ETIME 101 ; inline : EOPNOTSUPP 102 ; inline : ENOPOLICY 103 ; inline - -: _UTX_USERSIZE 256 ; inline -: _UTX_LINESIZE 32 ; inline -: _UTX_IDSIZE 4 ; inline -: _UTX_HOSTSIZE 256 ; inline - -C-STRUCT: utmpx - { { "char" _UTX_USERSIZE } "ut_user" } - { { "char" _UTX_IDSIZE } "ut_id" } - { { "char" _UTX_LINESIZE } "ut_line" } - { "pid_t" "ut_pid" } - { "short" "ut_type" } - { "timeval" "ut_tv" } - { { "char" _UTX_HOSTSIZE } "ut_host" } - { { "uint" 16 } "ut_pad" } ; - -: __PTHREAD_MUTEX_SIZE__ 40 ; inline - -C-STRUCT: _opaque_pthread_mutex_t - { "long" "__sig" } - { { "char" __PTHREAD_MUTEX_SIZE__ } "__opaque" } ; - -TYPEDEF: _opaque_pthread_mutex_t* __darwin_pthread_mutex_t - -: __DARWIN_MAXPATHLEN 1024 ; inline -: __DARWIN_MAXNAMELEN 255 ; inline -: __DARWIN_MAXNAMELEN+1 255 ; inline - -C-STRUCT: dirent - { "ino_t" "d_ino" } - { "__uint16_t" "d_reclen" } - { "__uint8_t" "d_type" } - { "__uint8_t" "d_namlen" } - { { "char" __DARWIN_MAXNAMELEN+1 } "d_name" } ; diff --git a/basis/unix/bsd/netbsd/netbsd.factor b/basis/unix/bsd/netbsd/netbsd.factor index ca42b7840c..6c45811d51 100644 --- a/basis/unix/bsd/netbsd/netbsd.factor +++ b/basis/unix/bsd/netbsd/netbsd.factor @@ -13,6 +13,23 @@ C-STRUCT: addrinfo { "void*" "addr" } { "addrinfo*" "next" } ; +C-STRUCT: dirent + { "ino_t" "d_fileno" } + { "__uint16_t" "d_reclen" } + { "__uint16_t" "d_namlen" } + { "__uint8_t" "d_type" } + { { "char" 512 } "d_name" } ; + +: DT_UNKNOWN 0 ; inline +: DT_FIFO 1 ; inline +: DT_CHR 2 ; inline +: DT_DIR 4 ; inline +: DT_BLK 6 ; inline +: DT_REG 8 ; inline +: DT_LNK 10 ; inline +: DT_SOCK 12 ; inline +: DT_WHT 14 ; inline + : EPERM 1 ; inline : ENOENT 2 ; inline : ESRCH 3 ; inline diff --git a/basis/unix/bsd/openbsd/openbsd.factor b/basis/unix/bsd/openbsd/openbsd.factor index 31025a47e9..f4a7863fdd 100644 --- a/basis/unix/bsd/openbsd/openbsd.factor +++ b/basis/unix/bsd/openbsd/openbsd.factor @@ -13,6 +13,24 @@ C-STRUCT: addrinfo { "char*" "canonname" } { "addrinfo*" "next" } ; +C-STRUCT: dirent + { "__uint32_t" "d_fileno" } + { "__uint16_t" "d_reclen" } + { "__uint8_t" "d_type" } + { "__uint8_t" "d_namlen" } + { { "char" 256 } "d_name" } ; + +: DT_UNKNOWN 0 ; inline +: DT_FIFO 1 ; inline +: DT_CHR 2 ; inline +: DT_DIR 4 ; inline +: DT_BLK 6 ; inline +: DT_REG 8 ; inline +: DT_LNK 10 ; inline +: DT_SOCK 12 ; inline + + + : EPERM 1 ; inline : ENOENT 2 ; inline : ESRCH 3 ; inline From 60941f4eb5ab32b29af85fa39942ad515b0f4b70 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 14:56:22 -0500 Subject: [PATCH 10/35] fix types --- basis/unix/types/linux/linux.factor | 9 ++------- basis/unix/types/netbsd/netbsd.factor | 13 ------------- basis/unix/types/openbsd/openbsd.factor | 13 ------------- basis/unix/types/types.factor | 5 +++++ 4 files changed, 7 insertions(+), 33 deletions(-) diff --git a/basis/unix/types/linux/linux.factor b/basis/unix/types/linux/linux.factor index 8822366a3a..65731335d8 100644 --- a/basis/unix/types/linux/linux.factor +++ b/basis/unix/types/linux/linux.factor @@ -1,10 +1,6 @@ - USING: alien.syntax ; - IN: unix.types -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - TYPEDEF: ulonglong __uquad_type TYPEDEF: ulong __ulongword_type TYPEDEF: long __sword_type @@ -13,10 +9,9 @@ TYPEDEF: long __slongword_type TYPEDEF: uint __u32_type TYPEDEF: int __s32_type -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - TYPEDEF: __uquad_type dev_t TYPEDEF: __ulongword_type ino_t +TYPEDEF: ino_t __ino_t TYPEDEF: __u32_type mode_t TYPEDEF: __uword_type nlink_t TYPEDEF: __u32_type uid_t @@ -26,4 +21,4 @@ TYPEDEF: __slongword_type blksize_t TYPEDEF: __slongword_type blkcnt_t TYPEDEF: __sword_type ssize_t TYPEDEF: __s32_type pid_t -TYPEDEF: __slongword_type time_t \ No newline at end of file +TYPEDEF: __slongword_type time_t diff --git a/basis/unix/types/netbsd/netbsd.factor b/basis/unix/types/netbsd/netbsd.factor index 5b54928d95..3982d1e9f9 100644 --- a/basis/unix/types/netbsd/netbsd.factor +++ b/basis/unix/types/netbsd/netbsd.factor @@ -3,19 +3,6 @@ IN: unix.types ! NetBSD 4.0 -TYPEDEF: short __int16_t -TYPEDEF: ushort __uint16_t -TYPEDEF: int __int32_t -TYPEDEF: uint __uint32_t -TYPEDEF: longlong __int64_t -TYPEDEF: longlong __uint64_t - -TYPEDEF: int int32_t -TYPEDEF: uint uint32_t -TYPEDEF: uint u_int32_t -TYPEDEF: longlong int64_t -TYPEDEF: ulonglong u_int64_t - TYPEDEF: __uint32_t __dev_t TYPEDEF: __uint32_t dev_t TYPEDEF: __uint32_t mode_t diff --git a/basis/unix/types/openbsd/openbsd.factor b/basis/unix/types/openbsd/openbsd.factor index a07e6f1c6a..8938afa936 100644 --- a/basis/unix/types/openbsd/openbsd.factor +++ b/basis/unix/types/openbsd/openbsd.factor @@ -3,19 +3,6 @@ IN: unix.types ! OpenBSD 4.2 -TYPEDEF: short __int16_t -TYPEDEF: ushort __uint16_t -TYPEDEF: int __int32_t -TYPEDEF: uint __uint32_t -TYPEDEF: longlong __int64_t -TYPEDEF: longlong __uint64_t - -TYPEDEF: int int32_t -TYPEDEF: uint u_int32_t -TYPEDEF: uint uint32_t -TYPEDEF: longlong int64_t -TYPEDEF: ulonglong u_int64_t - TYPEDEF: __uint32_t __dev_t TYPEDEF: __uint32_t dev_t TYPEDEF: __uint32_t ino_t diff --git a/basis/unix/types/types.factor b/basis/unix/types/types.factor index 69d07a07f1..968b234b9f 100644 --- a/basis/unix/types/types.factor +++ b/basis/unix/types/types.factor @@ -16,6 +16,11 @@ TYPEDEF: ushort uint16_t TYPEDEF: uint uint32_t TYPEDEF: ulonglong uint64_t +TYPEDEF: uchar u_int8_t +TYPEDEF: ushort u_int16_t +TYPEDEF: uint u_int32_t +TYPEDEF: ulonglong u_int64_t + TYPEDEF: char __int8_t TYPEDEF: short __int16_t TYPEDEF: int __int32_t From d4916e9fcba15e7ae38aa8bd774a2e8ec0b9e4b1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 15:03:29 -0500 Subject: [PATCH 11/35] fix type --- basis/unix/types/linux/linux.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/basis/unix/types/linux/linux.factor b/basis/unix/types/linux/linux.factor index 65731335d8..f32d8a23c4 100644 --- a/basis/unix/types/linux/linux.factor +++ b/basis/unix/types/linux/linux.factor @@ -17,6 +17,7 @@ TYPEDEF: __uword_type nlink_t TYPEDEF: __u32_type uid_t TYPEDEF: __u32_type gid_t TYPEDEF: __slongword_type off_t +TYPEDEF: off_t __off_t TYPEDEF: __slongword_type blksize_t TYPEDEF: __slongword_type blkcnt_t TYPEDEF: __sword_type ssize_t From d4fcc10aac34fa980d0e3b7d891376160a76ee32 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 15:29:59 -0500 Subject: [PATCH 12/35] fix windows directory code --- basis/io/windows/files/files.factor | 36 +++++++++++++++++++++++++---- basis/windows/errors/errors.factor | 2 +- 2 files changed, 33 insertions(+), 5 deletions(-) diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor index dbe16f0a6e..992d1f8d6a 100644 --- a/basis/io/windows/files/files.factor +++ b/basis/io/windows/files/files.factor @@ -1,10 +1,11 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types io.binary io.backend io.files io.buffers -io.windows kernel math splitting +io.windows kernel math splitting fry alien.strings windows windows.kernel32 windows.time calendar combinators math.functions sequences namespaces make words symbols system -io.ports destructors accessors math.bitwise ; +io.ports destructors accessors math.bitwise continuations +windows.errors arrays ; IN: io.windows.files : open-file ( path access-mode create-mode flags -- handle ) @@ -113,8 +114,35 @@ M: windows delete-directory ( path -- ) normalize-path RemoveDirectory win32-error=0/f ; -M: windows normalize-directory ( string -- string ) - normalize-path "\\" ?tail drop "\\*" append ; +M: windows >directory-entry ( byte-array -- directory-entry ) + [ WIN32_FIND_DATA-cFileName utf16n alien>string ] + [ WIN32_FIND_DATA-dwFileAttributes ] + bi directory-entry boa ; + +: find-first-file ( path -- WIN32_FIND_DATA handle ) + "WIN32_FIND_DATA" tuck + FindFirstFile + [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep ; + +: find-next-file ( path -- WIN32_FIND_DATA/f ) + "WIN32_FIND_DATA" tuck + FindNextFile 0 = [ + GetLastError ERROR_NO_MORE_FILES = [ + win32-error + ] unless drop f + ] when ; + +M: windows (directory-entries) ( path -- seq ) + "\\" ?tail drop "\\*" append + find-first-file [ >directory-entry ] dip + [ + '[ + [ _ find-next-file dup ] + [ >directory-entry ] + [ drop ] produce + over name>> "." = [ nip ] [ swap prefix ] if + ] + ] [ '[ _ FindClose win32-error=0/f ] ] bi [ ] cleanup ; SYMBOLS: +read-only+ +hidden+ +system+ +archive+ +device+ +normal+ +temporary+ diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index 31a7cd8c09..bd938fdbad 100644 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -2,9 +2,9 @@ USING: kernel ; IN: windows.errors : ERROR_SUCCESS 0 ; inline +: ERROR_NO_MORE_FILES 18 ; inline : ERROR_HANDLE_EOF 38 ; inline : ERROR_BROKEN_PIPE 109 ; inline : ERROR_ENVVAR_NOT_FOUND 203 ; inline : ERROR_IO_INCOMPLETE 996 ; inline : ERROR_IO_PENDING 997 ; inline - From c9b15e98794a1bbd92c21051716b8cd654fbff6f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 15:41:04 -0500 Subject: [PATCH 13/35] fix logging --- basis/logging/server/server.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/logging/server/server.factor b/basis/logging/server/server.factor index d13ae616be..47656e8655 100644 --- a/basis/logging/server/server.factor +++ b/basis/logging/server/server.factor @@ -83,7 +83,7 @@ SYMBOL: log-files : (rotate-logs) ( -- ) (close-logs) - log-root directory [ drop rotate-log ] assoc-each ; + log-root directory-files [ rotate-log ] each ; : log-server-loop ( -- ) receive unclip { From ef51d1bbf058e8fee294ad7e8e45ca40e4e057b4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 15:52:59 -0500 Subject: [PATCH 14/35] refactoring --- extra/html/parser/analyzer/analyzer.factor | 93 +++++++++++++--------- 1 file changed, 57 insertions(+), 36 deletions(-) diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index 095e3c3246..8d7a92b0d9 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -3,7 +3,7 @@ USING: assocs html.parser kernel math sequences strings ascii arrays generalizations shuffle unicode.case namespaces make splitting http accessors io combinators http.client urls -urls.encoding fry ; +urls.encoding fry prettyprint ; IN: html.parser.analyzer TUPLE: link attributes clickable ; @@ -19,35 +19,34 @@ TUPLE: link attributes clickable ; '[ _ [ second @ ] find-from rot drop swap 1+ ] [ f 0 ] 2dip times drop first2 ; inline -: find-first-name ( str vector -- i/f tag/f ) - [ >lower ] dip [ name>> = ] with find ; inline +: find-first-name ( vector string -- i/f tag/f ) + >lower '[ name>> _ = ] find ; inline -: find-matching-close ( str vector -- i/f tag/f ) - [ >lower ] dip - [ [ name>> = ] [ closing?>> ] bi and ] with find ; inline +: find-matching-close ( vector string -- i/f tag/f ) + >lower + '[ [ name>> _ = ] [ closing?>> ] bi and ] find ; inline -: find-between* ( i/f tag/f vector -- vector ) - pick integer? [ - rot tail-slice - >r name>> r> - [ find-matching-close drop dup [ 1+ ] when ] keep - swap [ head ] [ first ] if* +: find-between* ( vector i/f tag/f -- vector ) + over integer? [ + [ tail-slice ] [ name>> ] bi* + dupd find-matching-close drop dup [ 1+ ] when + [ head ] [ first ] if* ] [ 3drop V{ } clone ] if ; inline - -: find-between ( i/f tag/f vector -- vector ) + +: find-between ( vector i/f tag/f -- vector ) find-between* dup length 3 >= [ [ rest-slice but-last-slice ] keep like ] when ; inline -: find-between-first ( string vector -- vector' ) - [ find-first-name ] keep find-between ; inline +: find-between-first ( vector string -- vector' ) + dupd find-first-name find-between ; inline : find-between-all ( vector quot -- seq ) - [ [ [ closing?>> not ] bi and ] curry find-all ] curry - [ [ >r first2 r> find-between* ] curry map ] bi ; inline - + dupd + '[ _ [ closing?>> not ] bi and ] find-all + [ first2 find-between* ] with map ; : remove-blank-text ( vector -- vector' ) [ @@ -61,27 +60,40 @@ TUPLE: link attributes clickable ; [ [ [ blank? ] trim ] change-text ] when ] map ; -: find-by-id ( id vector -- vector ) - [ attributes>> "id" swap at = ] with filter ; +: find-by-id ( vector id -- vector' ) + '[ attributes>> "id" at _ = ] find ; + +: find-by-class ( vector id -- vector' ) + '[ attributes>> "class" at _ = ] find ; -: find-by-class ( id vector -- vector ) - [ attributes>> "class" swap at = ] with filter ; +: find-by-name ( vector string -- vector ) + >lower '[ name>> _ = ] find ; -: find-by-name ( str vector -- vector ) - [ >lower ] dip [ name>> = ] with filter ; +: find-by-id-between ( vector string -- vector' ) + dupd + '[ attributes>> "id" swap at _ = ] find find-between* ; + +: find-by-class-between ( vector string -- vector' ) + dupd + '[ attributes>> "class" swap at _ = ] find find-between* ; + +: find-by-class-id-between ( vector class id -- vector' ) + '[ + [ attributes>> "class" swap at _ = ] + [ attributes>> "id" swap at _ = ] bi and + ] dupd find find-between* ; -: find-by-attribute-key ( key vector -- vector ) - [ >lower ] dip - [ attributes>> at ] with filter - sift ; +: find-by-attribute-key ( vector key -- vector' ) + >lower + [ attributes>> at _ = ] filter sift ; -: find-by-attribute-key-value ( value key vector -- vector ) - [ >lower ] dip +: find-by-attribute-key-value ( vector value key -- vector' ) + >lower [ attributes>> at over = ] with filter nip sift ; -: find-first-attribute-key-value ( value key vector -- i/f tag/f ) - [ >lower ] dip +: find-first-attribute-key-value ( vector value key -- i/f tag/f ) + >lower [ attributes>> at over = ] with find rot drop ; : tag-link ( tag -- link/f ) @@ -121,9 +133,9 @@ TUPLE: link attributes clickable ; swap [ >r first2 r> find-between* ] curry map [ [ name>> { "form" "input" } member? ] filter ] map ; -: find-html-objects ( string vector -- vector' ) - [ find-opening-tags-by-name ] keep - [ [ first2 ] dip find-between* ] curry map ; +: find-html-objects ( vector string -- vector' ) + dupd find-opening-tags-by-name + [ first2 find-between* ] curry map ; : form-action ( vector -- string ) [ name>> "form" = ] find nip @@ -150,3 +162,12 @@ TUPLE: link attributes clickable ; : query>assoc* ( str -- hash ) "?" split1 nip query>assoc ; + +: html-class? ( tag string -- ? ) + swap attributes>> "class" swap at = ; + +: html-id? ( tag string -- ? ) + swap attributes>> "id" swap at = ; + +: opening-tag? ( tag -- ? ) + closing?>> not ; From 12a721869ca8da848cdc2199f049a72bac59d510 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 16:33:09 -0500 Subject: [PATCH 15/35] directory usage --- extra/ftp/ftp.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/ftp/ftp.factor b/extra/ftp/ftp.factor index b2b5ebc9aa..1fd97df6d5 100644 --- a/extra/ftp/ftp.factor +++ b/extra/ftp/ftp.factor @@ -59,5 +59,5 @@ TUPLE: ftp-response n strings parsed ; 3array " " join ; : directory-list ( -- seq ) - "" directory keys + "" directory-files [ [ link-info ] keep file-info>string ] map ; From f324ceb2b074d173e7e17a91375cc54904dbaf17 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 16:50:11 -0500 Subject: [PATCH 16/35] remove some macroz --- vm/os-freebsd.h | 3 --- vm/os-linux.h | 3 --- vm/os-macosx.h | 2 -- vm/os-openbsd.h | 2 -- vm/os-solaris.h | 2 -- vm/platform.h | 2 -- 6 files changed, 14 deletions(-) delete mode 100644 vm/os-openbsd.h delete mode 100644 vm/os-solaris.h diff --git a/vm/os-freebsd.h b/vm/os-freebsd.h index c535e2d71f..617a6686c2 100644 --- a/vm/os-freebsd.h +++ b/vm/os-freebsd.h @@ -7,6 +7,3 @@ extern int getosreldate(void); #ifndef KERN_PROC_PATHNAME #define KERN_PROC_PATHNAME 12 #endif - -#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN) -#define DIRECTORY_P(file) ((file)->d_type == DT_DIR) diff --git a/vm/os-linux.h b/vm/os-linux.h index 78ecbafd35..8e78595687 100644 --- a/vm/os-linux.h +++ b/vm/os-linux.h @@ -1,8 +1,5 @@ #include -#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN) -#define DIRECTORY_P(file) ((file)->d_type == DT_DIR) - int inotify_init(void); int inotify_add_watch(int fd, const char *name, u32 mask); int inotify_rm_watch(int fd, u32 wd); diff --git a/vm/os-macosx.h b/vm/os-macosx.h index b9686a5a85..216212e973 100644 --- a/vm/os-macosx.h +++ b/vm/os-macosx.h @@ -1,8 +1,6 @@ #define DLLEXPORT __attribute__((visibility("default"))) #define FACTOR_OS_STRING "macosx" #define NULL_DLL "libfactor.dylib" -#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN) -#define DIRECTORY_P(file) ((file)->d_type == DT_DIR) void init_signals(void); void early_init(void); diff --git a/vm/os-openbsd.h b/vm/os-openbsd.h deleted file mode 100644 index af47f7bcea..0000000000 --- a/vm/os-openbsd.h +++ /dev/null @@ -1,2 +0,0 @@ -#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN) -#define DIRECTORY_P(file) ((file)->d_type == DT_DIR) diff --git a/vm/os-solaris.h b/vm/os-solaris.h deleted file mode 100644 index 788a78090b..0000000000 --- a/vm/os-solaris.h +++ /dev/null @@ -1,2 +0,0 @@ -#define UNKNOWN_TYPE_P(file) 1 -#define DIRECTORY_P(file) 0 diff --git a/vm/platform.h b/vm/platform.h index 2f97cb9d1d..21336e88bb 100644 --- a/vm/platform.h +++ b/vm/platform.h @@ -55,7 +55,6 @@ #endif #elif defined(__OpenBSD__) #define FACTOR_OS_STRING "openbsd" - #include "os-openbsd.h" #if defined(FACTOR_X86) #include "os-openbsd-x86.32.h" @@ -102,7 +101,6 @@ #error "Unsupported Solaris flavor" #endif - #include "os-solaris.h" #else #error "Unsupported OS" #endif From 0ad47e21c803b9771d5f4e3fc5ea885f3571310e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 16:50:34 -0500 Subject: [PATCH 17/35] using bug --- basis/io/windows/nt/launcher/test/env.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/basis/io/windows/nt/launcher/test/env.factor b/basis/io/windows/nt/launcher/test/env.factor index a0015f7ea2..503ca7d018 100644 --- a/basis/io/windows/nt/launcher/test/env.factor +++ b/basis/io/windows/nt/launcher/test/env.factor @@ -1,3 +1,4 @@ -USE: system -USE: prettyprint -os-envs . +USE: system +USE: prettyprint +USE: environment +os-envs . From 964961ed74bc68325de30f95933cf20f32e5a687 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 18:13:59 -0500 Subject: [PATCH 18/35] remove dead code --- vm/os-windows-nt.c | 29 ----------------------------- 1 file changed, 29 deletions(-) diff --git a/vm/os-windows-nt.c b/vm/os-windows-nt.c index 4f5778d0c4..54afd1c147 100755 --- a/vm/os-windows-nt.c +++ b/vm/os-windows-nt.c @@ -8,35 +8,6 @@ s64 current_millis(void) - EPOCH_OFFSET) / 10000; } -DEFINE_PRIMITIVE(os_envs) -{ - GROWABLE_ARRAY(result); - REGISTER_ROOT(result); - - TCHAR *env = GetEnvironmentStrings(); - TCHAR *finger = env; - - for(;;) - { - TCHAR *scan = finger; - while(*scan != '\0') - scan++; - if(scan == finger) - break; - - CELL string = tag_object(from_u16_string(finger)); - GROWABLE_ARRAY_ADD(result,string); - - finger = scan + 1; - } - - FreeEnvironmentStrings(env); - - UNREGISTER_ROOT(result); - GROWABLE_ARRAY_TRIM(result); - dpush(result); -} - long exception_handler(PEXCEPTION_POINTERS pe) { PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord; From e310e382c5afaeb5e8dd166ab030c98b5f92316b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 18:30:51 -0500 Subject: [PATCH 19/35] fix io monitors recusive --- basis/io/monitors/recursive/recursive.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/basis/io/monitors/recursive/recursive.factor b/basis/io/monitors/recursive/recursive.factor index 3cecee2b1e..45979363c9 100644 --- a/basis/io/monitors/recursive/recursive.factor +++ b/basis/io/monitors/recursive/recursive.factor @@ -19,7 +19,8 @@ DEFER: add-child-monitor : add-child-monitors ( path -- ) #! We yield since this directory scan might take a while. - [ + dup [ + [ append-path ] with map [ add-child-monitor ] each yield ] with-directory-files ; From e4b6cd7578de989d8ef7bdb222cf6b84857db315 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 18:47:23 -0500 Subject: [PATCH 20/35] directory throws now instead of returning nicely if does not exist --- basis/tools/vocabs/vocabs.factor | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/basis/tools/vocabs/vocabs.factor b/basis/tools/vocabs/vocabs.factor index 05f354a8a8..1f81ac5802 100644 --- a/basis/tools/vocabs/vocabs.factor +++ b/basis/tools/vocabs/vocabs.factor @@ -207,13 +207,16 @@ M: vocab-link summary vocab-summary ; dup vocab-authors-path set-vocab-file-contents ; : subdirs ( dir -- dirs ) - [ + dup [ [ link-info directory? ] filter - ] with-directory-files natural-sort ; + ] with-directory-files + [ append-path ] with map natural-sort ; : (all-child-vocabs) ( root name -- vocabs ) - [ vocab-dir append-path subdirs ] keep [ + vocab-dir append-path dup exists? + [ subdirs ] [ drop { } ] if + ] keep [ swap [ "." swap 3append ] with map ] unless-empty ; From 4f948ef5ce842fca41a36e6306db4bd809bb6b09 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 19:39:20 -0500 Subject: [PATCH 21/35] try to make bootstrap work again --- basis/unix/stat/linux/32/32.factor | 12 ++++ basis/unix/stat/linux/64/64.factor | 91 +++++++++++++++++++++++++++++- 2 files changed, 101 insertions(+), 2 deletions(-) diff --git a/basis/unix/stat/linux/32/32.factor b/basis/unix/stat/linux/32/32.factor index 3f6c6ba0e0..d05ae2e550 100644 --- a/basis/unix/stat/linux/32/32.factor +++ b/basis/unix/stat/linux/32/32.factor @@ -31,3 +31,15 @@ FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ; : stat ( pathname buf -- int ) 3 -rot __xstat ; : lstat ( pathname buf -- int ) 3 -rot __lxstat ; + +C-STRUCT: statfs + { "long" "f_type" } + { "long" "f_bsize" } + { "long" "f_blocks" } + { "long" "f_bfree" } + { "long" "f_bavail" } + { "long" "f_files" } + { "long" "f_ffree" } + { "fsid_t" "f_fsid" } + { "long" "f_namelen" } ; + diff --git a/basis/unix/stat/linux/64/64.factor b/basis/unix/stat/linux/64/64.factor index 088ab8d339..e7c5ca69c6 100644 --- a/basis/unix/stat/linux/64/64.factor +++ b/basis/unix/stat/linux/64/64.factor @@ -1,5 +1,5 @@ - -USING: kernel alien.syntax math ; +USING: kernel alien.syntax math sequences unix +alien.c-types arrays accessors combinators ; IN: unix.stat @@ -29,3 +29,90 @@ FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ; : stat ( pathname buf -- int ) 1 -rot __xstat ; : lstat ( pathname buf -- int ) 1 -rot __lxstat ; + +C-STRUCT: fstab + { "char*" "fs_spec" } + { "char*" "fs_file" } + { "char*" "fs_vfstype" } + { "char*" "fs_mntops" } + { "char*" "fs_type" } + { "int" "fs_freq" } + { "int" "fs_passno" } ; + +FUNCTION: fstab* getfsent ( ) ; +FUNCTION: fstab* getfsspec ( char* name ) ; +FUNCTION: fstab* getfsfile ( char* name ) ; +FUNCTION: int setfsent ( ) ; +FUNCTION: void endfsent ( ) ; + +TUPLE: fstab spec file vfstype mntops type freq passno ; + +: fstab-struct>fstab ( struct -- fstab ) + [ fstab new ] dip + { + [ fstab-fs_spec >>spec ] + [ fstab-fs_file >>file ] + [ fstab-fs_vfstype >>vfstype ] + [ fstab-fs_mntops >>mntops ] + [ fstab-fs_type >>type ] + [ fstab-fs_freq >>freq ] + [ fstab-fs_passno >>passno ] + } cleave ; + +C-STRUCT: fsid + { { "int" 2 } "__val" } ; + +TYPEDEF: fsid __fsid_t + +TYPEDEF: ssize_t __SWORD_TYPE +TYPEDEF: ulonglong __fsblkcnt64_t +TYPEDEF: ulonglong __fsfilcnt64_t + +C-STRUCT: statfs64 + { "__SWORD_TYPE" "f_type" } + { "__SWORD_TYPE" "f_bsize" } + { "__fsblkcnt64_t" "f_blocks" } + { "__fsblkcnt64_t" "f_bfree" } + { "__fsblkcnt64_t" "f_bavail" } + { "__fsfilcnt64_t" "f_files" } + { "__fsfilcnt64_t" "f_ffree" } + { "__fsid_t" "f_fsid" } + { "__SWORD_TYPE" "f_namelen" } + { "__SWORD_TYPE" "f_frsize" } + { { "__SWORD_TYPE" 5 } "f_spare" } ; + +TUPLE: statfs type bsize blocks bfree bavail files ffree fsid +namelen frsize spare ; + +: statfs-struct>statfs ( struct -- statfs ) + [ \ statfs new ] dip + { + [ statfs64-f_type >>type ] + [ statfs64-f_bsize >>bsize ] + [ statfs64-f_blocks >>blocks ] + [ statfs64-f_bfree >>bfree ] + [ statfs64-f_bavail >>bavail ] + [ statfs64-f_files >>files ] + [ statfs64-f_ffree >>ffree ] + [ statfs64-f_fsid >>fsid ] + [ statfs64-f_namelen >>namelen ] + [ statfs64-f_frsize >>frsize ] + [ statfs64-f_spare >>spare ] + } cleave ; + +FUNCTION: int statfs64 ( char* path, statfs64* buf ) ; +: statfs ( path -- byte-array ) + "statfs64" [ statfs64 io-error ] keep ; + +: all-fstabs ( -- seq ) + setfsent io-error + [ getfsent dup ] [ fstab-struct>fstab ] [ drop ] produce endfsent ; + +C-STRUCT: mntent + { "char*" "mnt_fsname" } + { "char*" "mnt_dir" } + { "char*" "mnt_type" } + { "char*" "mnt_opts" } + { "int" "mnt_freq" } + { "int" "mnt_passno" } ; + From 16f7c09b544039dca158b38db9ca78ba817bd762 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 19:43:46 -0500 Subject: [PATCH 22/35] try to fix bootstrap --- basis/unix/stat/linux/64/64.factor | 5 ----- basis/unix/stat/linux/linux.factor | 7 ++++++- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/basis/unix/stat/linux/64/64.factor b/basis/unix/stat/linux/64/64.factor index e7c5ca69c6..03791bc8bd 100644 --- a/basis/unix/stat/linux/64/64.factor +++ b/basis/unix/stat/linux/64/64.factor @@ -59,11 +59,6 @@ TUPLE: fstab spec file vfstype mntops type freq passno ; [ fstab-fs_passno >>passno ] } cleave ; -C-STRUCT: fsid - { { "int" 2 } "__val" } ; - -TYPEDEF: fsid __fsid_t - TYPEDEF: ssize_t __SWORD_TYPE TYPEDEF: ulonglong __fsblkcnt64_t TYPEDEF: ulonglong __fsfilcnt64_t diff --git a/basis/unix/stat/linux/linux.factor b/basis/unix/stat/linux/linux.factor index 1df6865d41..aa48fd37ea 100644 --- a/basis/unix/stat/linux/linux.factor +++ b/basis/unix/stat/linux/linux.factor @@ -1,6 +1,11 @@ -USING: layouts combinators vocabs.loader ; +USING: alien.syntax layouts combinators vocabs.loader ; IN: unix.stat +C-STRUCT: fsid + { { "int" 2 } "__val" } ; + +TYPEDEF: fsid __fsid_t + cell-bits { { 32 [ "unix.stat.linux.32" require ] } From dcd534292e33d4ddf831c36d6cb03cdfffcbfc24 Mon Sep 17 00:00:00 2001 From: erg Date: Sun, 19 Oct 2008 19:45:54 -0500 Subject: [PATCH 23/35] fixes --- basis/unix/stat/linux/32/32.factor | 3 --- basis/unix/stat/linux/linux.factor | 1 + 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/basis/unix/stat/linux/32/32.factor b/basis/unix/stat/linux/32/32.factor index d05ae2e550..00a6239916 100644 --- a/basis/unix/stat/linux/32/32.factor +++ b/basis/unix/stat/linux/32/32.factor @@ -1,6 +1,4 @@ - USING: kernel alien.syntax math ; - IN: unix.stat ! Ubuntu 8.04 32-bit @@ -42,4 +40,3 @@ C-STRUCT: statfs { "long" "f_ffree" } { "fsid_t" "f_fsid" } { "long" "f_namelen" } ; - diff --git a/basis/unix/stat/linux/linux.factor b/basis/unix/stat/linux/linux.factor index aa48fd37ea..4bcab0b477 100644 --- a/basis/unix/stat/linux/linux.factor +++ b/basis/unix/stat/linux/linux.factor @@ -5,6 +5,7 @@ C-STRUCT: fsid { { "int" 2 } "__val" } ; TYPEDEF: fsid __fsid_t +TYPEDEF: fsid fsid_t cell-bits { From d77771eec8dc1fcab3f1b36f8b3f79c25bbfe4a9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 19:47:37 -0500 Subject: [PATCH 24/35] fix test --- basis/io/windows/nt/launcher/launcher-tests.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/windows/nt/launcher/launcher-tests.factor b/basis/io/windows/nt/launcher/launcher-tests.factor index d5e77caa19..48859dc6df 100644 --- a/basis/io/windows/nt/launcher/launcher-tests.factor +++ b/basis/io/windows/nt/launcher/launcher-tests.factor @@ -1,7 +1,7 @@ -IN: io.windows.launcher.nt.tests -USING: io.launcher tools.test calendar accessors +USING: io.launcher tools.test calendar accessors environmnent namespaces kernel system arrays io io.files io.encodings.ascii sequences parser assocs hashtables math continuations eval ; +IN: io.windows.launcher.nt.tests [ ] [ From 16f2a281d6d2552e0becf581af7882bbcc5e277c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 20:30:54 -0500 Subject: [PATCH 25/35] typo --- basis/io/windows/nt/launcher/launcher-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/windows/nt/launcher/launcher-tests.factor b/basis/io/windows/nt/launcher/launcher-tests.factor index 48859dc6df..949b0a7961 100644 --- a/basis/io/windows/nt/launcher/launcher-tests.factor +++ b/basis/io/windows/nt/launcher/launcher-tests.factor @@ -1,4 +1,4 @@ -USING: io.launcher tools.test calendar accessors environmnent +USING: io.launcher tools.test calendar accessors environment namespaces kernel system arrays io io.files io.encodings.ascii sequences parser assocs hashtables math continuations eval ; IN: io.windows.launcher.nt.tests From 3dc4002c35df24c647779de232a6d5aa1586ef4d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 20:37:11 -0500 Subject: [PATCH 26/35] fix subdirs --- basis/tools/vocabs/vocabs.factor | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/basis/tools/vocabs/vocabs.factor b/basis/tools/vocabs/vocabs.factor index 1f81ac5802..b929c62e04 100644 --- a/basis/tools/vocabs/vocabs.factor +++ b/basis/tools/vocabs/vocabs.factor @@ -207,10 +207,9 @@ M: vocab-link summary vocab-summary ; dup vocab-authors-path set-vocab-file-contents ; : subdirs ( dir -- dirs ) - dup [ + [ [ link-info directory? ] filter - ] with-directory-files - [ append-path ] with map natural-sort ; + ] with-directory-files natural-sort ; : (all-child-vocabs) ( root name -- vocabs ) [ From e9c79ee85ee61fc580e3d9e0ac70e87d6349ef0e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 20:42:27 -0500 Subject: [PATCH 27/35] fix directory. --- basis/http/server/static/static.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/basis/http/server/static/static.factor b/basis/http/server/static/static.factor index 3edcfe81cd..208273364c 100644 --- a/basis/http/server/static/static.factor +++ b/basis/http/server/static/static.factor @@ -68,8 +68,7 @@ TUPLE: file-responder root hook special allow-listings ; [

file-name escape-string write

] [
    - directory-files - [
  • file.
    • ] assoc-each + directory-files [
  • file.
    • ] each
] bi ] simple-page ; From 6037ed413d0c525daffbf6e6be40c98e8b783540 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 20:45:04 -0500 Subject: [PATCH 28/35] add unportable tags --- basis/unix/statfs/linux/tags.txt | 1 + basis/unix/statfs/macosx/tags.txt | 1 + 2 files changed, 2 insertions(+) create mode 100644 basis/unix/statfs/linux/tags.txt create mode 100644 basis/unix/statfs/macosx/tags.txt diff --git a/basis/unix/statfs/linux/tags.txt b/basis/unix/statfs/linux/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/statfs/linux/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/unix/statfs/macosx/tags.txt b/basis/unix/statfs/macosx/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/statfs/macosx/tags.txt @@ -0,0 +1 @@ +unportable From 54819c0f95d9871931447a88f5ef3201b95e5ce2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 20:45:34 -0500 Subject: [PATCH 29/35] more tags --- basis/unix/statfs/tags.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 basis/unix/statfs/tags.txt diff --git a/basis/unix/statfs/tags.txt b/basis/unix/statfs/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/statfs/tags.txt @@ -0,0 +1 @@ +unportable From 763f4f7503adcb1ab15224f2140984b6034a8278 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 22:01:14 -0500 Subject: [PATCH 30/35] move constants to bsd.factor --- basis/unix/bsd/bsd.factor | 10 ++++++++++ basis/unix/bsd/freebsd/freebsd.factor | 10 ---------- basis/unix/bsd/macosx/macosx.factor | 11 ----------- basis/unix/bsd/netbsd/netbsd.factor | 10 ---------- basis/unix/bsd/openbsd/openbsd.factor | 11 ----------- 5 files changed, 10 insertions(+), 42 deletions(-) diff --git a/basis/unix/bsd/bsd.factor b/basis/unix/bsd/bsd.factor index bf426ad867..bd66c5253e 100644 --- a/basis/unix/bsd/bsd.factor +++ b/basis/unix/bsd/bsd.factor @@ -83,6 +83,16 @@ C-STRUCT: passwd : SEEK_CUR 1 ; inline : SEEK_END 2 ; inline +: DT_UNKNOWN 0 ; inline +: DT_FIFO 1 ; inline +: DT_CHR 2 ; inline +: DT_DIR 4 ; inline +: DT_BLK 6 ; inline +: DT_REG 8 ; inline +: DT_LNK 10 ; inline +: DT_SOCK 12 ; inline +: DT_WHT 14 ; inline + os { { macosx [ "unix.bsd.macosx" require ] } { freebsd [ "unix.bsd.freebsd" require ] } diff --git a/basis/unix/bsd/freebsd/freebsd.factor b/basis/unix/bsd/freebsd/freebsd.factor index 3af6358e94..81885ff141 100644 --- a/basis/unix/bsd/freebsd/freebsd.factor +++ b/basis/unix/bsd/freebsd/freebsd.factor @@ -20,16 +20,6 @@ C-STRUCT: dirent { "u_int8_t" "d_namlen" } { { "char" 256 } "d_name" } ; -: DT_UNKNOWN 0 ; inline -: DT_FIFO 1 ; inline -: DT_CHR 2 ; inline -: DT_DIR 4 ; inline -: DT_BLK 6 ; inline -: DT_REG 8 ; inline -: DT_LNK 10 ; inline -: DT_SOCK 12 ; inline -: DT_WHT 14 ; inline - : EPERM 1 ; inline : ENOENT 2 ; inline : ESRCH 3 ; inline diff --git a/basis/unix/bsd/macosx/macosx.factor b/basis/unix/bsd/macosx/macosx.factor index de2fd4caf0..fb9eb9a621 100644 --- a/basis/unix/bsd/macosx/macosx.factor +++ b/basis/unix/bsd/macosx/macosx.factor @@ -39,17 +39,6 @@ C-STRUCT: dirent { "__uint8_t" "d_namlen" } { { "char" __DARWIN_MAXNAMELEN+1 } "d_name" } ; -: DT_UNKNOWN 0 ; inline -: DT_FIFO 1 ; inline -: DT_CHR 2 ; inline -: DT_DIR 4 ; inline -: DT_BLK 6 ; inline -: DT_REG 8 ; inline -: DT_LNK 10 ; inline -: DT_SOCK 12 ; inline -: DT_WHT 14 ; inline - - : EPERM 1 ; inline : ENOENT 2 ; inline : ESRCH 3 ; inline diff --git a/basis/unix/bsd/netbsd/netbsd.factor b/basis/unix/bsd/netbsd/netbsd.factor index 6c45811d51..bd6bcc407a 100644 --- a/basis/unix/bsd/netbsd/netbsd.factor +++ b/basis/unix/bsd/netbsd/netbsd.factor @@ -20,16 +20,6 @@ C-STRUCT: dirent { "__uint8_t" "d_type" } { { "char" 512 } "d_name" } ; -: DT_UNKNOWN 0 ; inline -: DT_FIFO 1 ; inline -: DT_CHR 2 ; inline -: DT_DIR 4 ; inline -: DT_BLK 6 ; inline -: DT_REG 8 ; inline -: DT_LNK 10 ; inline -: DT_SOCK 12 ; inline -: DT_WHT 14 ; inline - : EPERM 1 ; inline : ENOENT 2 ; inline : ESRCH 3 ; inline diff --git a/basis/unix/bsd/openbsd/openbsd.factor b/basis/unix/bsd/openbsd/openbsd.factor index f4a7863fdd..a4189775e7 100644 --- a/basis/unix/bsd/openbsd/openbsd.factor +++ b/basis/unix/bsd/openbsd/openbsd.factor @@ -20,17 +20,6 @@ C-STRUCT: dirent { "__uint8_t" "d_namlen" } { { "char" 256 } "d_name" } ; -: DT_UNKNOWN 0 ; inline -: DT_FIFO 1 ; inline -: DT_CHR 2 ; inline -: DT_DIR 4 ; inline -: DT_BLK 6 ; inline -: DT_REG 8 ; inline -: DT_LNK 10 ; inline -: DT_SOCK 12 ; inline - - - : EPERM 1 ; inline : ENOENT 2 ; inline : ESRCH 3 ; inline From fe66a089e3a5423eea4adc63422e966481096e15 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 22:13:33 -0500 Subject: [PATCH 31/35] a convert to/from md5 shadow passwords. just for fun --- extra/crypto/passwd-md5/authors.txt | 1 + .../crypto/passwd-md5/passwd-md5-docs.factor | 34 ++++++++++++++ .../crypto/passwd-md5/passwd-md5-tests.factor | 16 +++++++ extra/crypto/passwd-md5/passwd-md5.factor | 47 +++++++++++++++++++ 4 files changed, 98 insertions(+) create mode 100644 extra/crypto/passwd-md5/authors.txt create mode 100644 extra/crypto/passwd-md5/passwd-md5-docs.factor create mode 100644 extra/crypto/passwd-md5/passwd-md5-tests.factor create mode 100644 extra/crypto/passwd-md5/passwd-md5.factor diff --git a/extra/crypto/passwd-md5/authors.txt b/extra/crypto/passwd-md5/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/crypto/passwd-md5/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/crypto/passwd-md5/passwd-md5-docs.factor b/extra/crypto/passwd-md5/passwd-md5-docs.factor new file mode 100644 index 0000000000..eb8f3e74a9 --- /dev/null +++ b/extra/crypto/passwd-md5/passwd-md5-docs.factor @@ -0,0 +1,34 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax io.streams.string strings ; +IN: crypto.passwd-md5 + +HELP: authenticate-password +{ $values + { "shadow" string } { "password" string } + { "?" "a boolean" } } +{ $description "Encodes the provided password and compares it to the encoded password entry from a shadowed password file." } ; + +HELP: parse-shadow-password +{ $values + { "string" string } + { "magic" string } { "salt" string } { "password" string } } +{ $description "Splits a shadowed password entry into a magic string, a salt, and an encoded password string." } ; + +HELP: passwd-md5 +{ $values + { "magic" string } { "salt" string } { "password" string } + { "bytes" "an md5-shadowed password entry" } } +{ $description "Encodes the password with the given magic string and salt to an MD5-shadow password entry." } ; + +ARTICLE: "crypto.passwd-md5" "MD5 shadow passwords" +"The " { $vocab-link "crypto.passwd-md5" } " vocabulary can encode passwords for use in an MD5 shadow password file." $nl + +"Encoding a password:" +{ $subsection passwd-md5 } +"Parsing a shadowed password entry:" +{ $subsection parse-shadow-password } +"Authenticating against a shadowed password:" +{ $subsection authenticate-password } ; + +ABOUT: "crypto.passwd-md5" diff --git a/extra/crypto/passwd-md5/passwd-md5-tests.factor b/extra/crypto/passwd-md5/passwd-md5-tests.factor new file mode 100644 index 0000000000..a858d8dab5 --- /dev/null +++ b/extra/crypto/passwd-md5/passwd-md5-tests.factor @@ -0,0 +1,16 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test crypto.passwd-md5 ; +IN: crypto.passwd-md5.tests + + +[ "$1$npUpD5oQ$1.X7uXR2QG0FzPifVeZ2o1" ] +[ "$1$" "npUpD5oQ" "factor" passwd-md5 ] unit-test + +[ "$1$Kilak4kR$wlEr5Dv5DcdqPjKjQtt430" ] +[ + "$1$" + "Kilak4kR" + "longpassword12345678901234567890" + passwd-md5 +] unit-test diff --git a/extra/crypto/passwd-md5/passwd-md5.factor b/extra/crypto/passwd-md5/passwd-md5.factor new file mode 100644 index 0000000000..32a913ef23 --- /dev/null +++ b/extra/crypto/passwd-md5/passwd-md5.factor @@ -0,0 +1,47 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel base64 checksums.md5 symbols sequences checksums +locals prettyprint math math.bitwise grouping io combinators +fry make combinators.short-circuit math.functions splitting ; +IN: crypto.passwd-md5 + + + +:: passwd-md5 ( magic salt password -- bytes ) + [let* | final! [ password magic salt 3append + salt password tuck 3append md5 checksum-bytes + password length + [ 16 / ceiling swap concat ] keep + head-slice append + password [ length ] [ first ] bi + '[ [ CHAR: \0 _ ? , ] each-bit ] "" make append + md5 checksum-bytes ] | + 1000 [ + "" swap + { + [ 0 bit? password final ? append ] + [ 3 mod 0 > [ salt append ] when ] + [ 7 mod 0 > [ password append ] when ] + [ 0 bit? final password ? append ] + } cleave md5 checksum-bytes final! + ] each + + magic salt "$" 3append + { 12 0 6 13 1 7 14 2 8 15 3 9 5 4 10 } final nths 3 group + [ first3 [ 16 shift ] [ 8 shift ] bi* + + 4 to64 ] map concat + 11 final nth 2 to64 3append ] ; + +: parse-shadow-password ( string -- magic salt password ) + "$" split harvest first3 [ "$" tuck 3append ] 2dip ; + +: authenticate-password ( shadow password -- ? ) + '[ parse-shadow-password drop _ passwd-md5 ] keep = ; From 0121d0f678b606f750abafb3cfb47fa33c0d7314 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 20 Oct 2008 00:30:24 -0500 Subject: [PATCH 32/35] add file-system-info --- basis/unix/stat/macosx/macosx.factor | 6 ------ core/io/files/files.factor | 9 ++++++++- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/basis/unix/stat/macosx/macosx.factor b/basis/unix/stat/macosx/macosx.factor index 03301d25b9..49b6709847 100644 --- a/basis/unix/stat/macosx/macosx.factor +++ b/basis/unix/stat/macosx/macosx.factor @@ -115,12 +115,6 @@ C-STRUCT: vfsquery : NFSV2_MAX_FH_SIZE 32 ; inline : NFS_MAX_FH_SIZE NFSV4_MAX_FH_SIZE ; inline -! C-STRUCT: fhandle - ! { "int" "fh_len" } - ! { { "uchar" NFS_MAX_FH_SIZE } "fh_data" } ; - -! TYPEDEF: fhandle fhandle_t - : MFSNAMELEN 15 ; inline : MNAMELEN 90 ; inline : MFSTYPENAMELEN 16 ; inline diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 8796834bc7..1f6a48b50e 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -153,7 +153,8 @@ PRIVATE> "." last-split1 nip ; ! File info -TUPLE: file-info type size permissions created modified accessed ; +TUPLE: file-info type size permissions created modified +accessed ; HOOK: file-info io-backend ( path -- info ) @@ -181,6 +182,12 @@ SYMBOL: +unknown+ : directory? ( file-info -- ? ) type>> +directory+ = ; +! File-system + +TUPLE: file-system-info mount-on free-space ; + +HOOK: file-system-info os ( path -- file-system-info ) + Date: Mon, 20 Oct 2008 00:47:51 -0500 Subject: [PATCH 33/35] add statfs stuff --- basis/unix/statfs/authors.txt | 1 + basis/unix/statfs/linux/authors.txt | 1 + basis/unix/statfs/linux/linux-tests.factor | 4 ++ basis/unix/statfs/linux/linux.factor | 28 +++++++++++ basis/unix/statfs/macosx/authors.txt | 1 + basis/unix/statfs/macosx/macosx-tests.factor | 4 ++ basis/unix/statfs/macosx/macosx.factor | 52 ++++++++++++++++++++ basis/unix/statfs/statfs-tests.factor | 4 ++ basis/unix/statfs/statfs.factor | 31 ++++++++++++ 9 files changed, 126 insertions(+) create mode 100644 basis/unix/statfs/authors.txt create mode 100644 basis/unix/statfs/linux/authors.txt create mode 100644 basis/unix/statfs/linux/linux-tests.factor create mode 100644 basis/unix/statfs/linux/linux.factor create mode 100644 basis/unix/statfs/macosx/authors.txt create mode 100644 basis/unix/statfs/macosx/macosx-tests.factor create mode 100644 basis/unix/statfs/macosx/macosx.factor create mode 100644 basis/unix/statfs/statfs-tests.factor create mode 100644 basis/unix/statfs/statfs.factor diff --git a/basis/unix/statfs/authors.txt b/basis/unix/statfs/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/unix/statfs/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/linux/authors.txt b/basis/unix/statfs/linux/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/unix/statfs/linux/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/linux/linux-tests.factor b/basis/unix/statfs/linux/linux-tests.factor new file mode 100644 index 0000000000..549905f081 --- /dev/null +++ b/basis/unix/statfs/linux/linux-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test unix.statfs.linux ; +IN: unix.statfs.linux.tests diff --git a/basis/unix/statfs/linux/linux.factor b/basis/unix/statfs/linux/linux.factor new file mode 100644 index 0000000000..b758503ab5 --- /dev/null +++ b/basis/unix/statfs/linux/linux.factor @@ -0,0 +1,28 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types combinators kernel ; +IN: unix.statfs.linux + +TUPLE: linux-file-system-info < file-system-info +type bsize blocks bfree bavail files ffree fsid +namelen frsize spare ; + +: statfs-struct>statfs ( struct -- statfs ) + [ \ statfs new ] dip + { + [ statfs64-f_type >>type ] + [ statfs64-f_bsize >>bsize ] + [ statfs64-f_blocks >>blocks ] + [ statfs64-f_bfree >>bfree ] + [ statfs64-f_bavail >>bavail ] + [ statfs64-f_files >>files ] + [ statfs64-f_ffree >>ffree ] + [ statfs64-f_fsid >>fsid ] + [ statfs64-f_namelen >>namelen ] + [ statfs64-f_frsize >>frsize ] + [ statfs64-f_spare >>spare ] + } cleave ; + +: statfs ( path -- byte-array ) + "statfs64" [ statfs64 io-error ] keep ; + diff --git a/basis/unix/statfs/macosx/authors.txt b/basis/unix/statfs/macosx/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/unix/statfs/macosx/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/macosx/macosx-tests.factor b/basis/unix/statfs/macosx/macosx-tests.factor new file mode 100644 index 0000000000..35625e2198 --- /dev/null +++ b/basis/unix/statfs/macosx/macosx-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test unix.statfs.macosx ; +IN: unix.statfs.macosx.tests diff --git a/basis/unix/statfs/macosx/macosx.factor b/basis/unix/statfs/macosx/macosx.factor new file mode 100644 index 0000000000..60fb1658c5 --- /dev/null +++ b/basis/unix/statfs/macosx/macosx.factor @@ -0,0 +1,52 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types io.encodings.utf8 io.encodings.string +kernel sequences unix.stat accessors unix combinators math +grouping system unix.statfs io.files io.backend alien.strings ; +IN: unix.statfs.macosx + +TUPLE: macosx-file-system-info < file-system-info +block-size io-size blocks blocks-free blocks-available files +files-free file-system-id owner type flags filesystem-subtype +file-system-type-name mount-from ; + +M: macosx mounted* ( -- array ) + f dup 0 getmntinfo64 dup io-error + [ *void* ] dip + "statfs64" heap-size [ * memory>byte-array ] keep group ; + +: statfs64>file-system-info ( byte-array -- file-system-info ) + [ \ macosx-file-system-info new ] dip + { + [ + [ statfs64-f_bavail ] [ statfs64-f_bsize ] bi * + >>free-space + ] + [ statfs64-f_mntonname utf8 alien>string >>mount-on ] + [ statfs64-f_bsize >>block-size ] + + [ statfs64-f_iosize >>io-size ] + [ statfs64-f_blocks >>blocks ] + [ statfs64-f_bfree >>blocks-free ] + [ statfs64-f_bavail >>blocks-available ] + [ statfs64-f_files >>files ] + [ statfs64-f_ffree >>files-free ] + [ statfs64-f_fsid >>file-system-id ] + [ statfs64-f_owner >>owner ] + [ statfs64-f_type >>type ] + [ statfs64-f_flags >>flags ] + [ statfs64-f_fssubtype >>filesystem-subtype ] + [ + statfs64-f_fstypename utf8 alien>string + >>file-system-type-name + ] + [ + statfs64-f_mntfromname + utf8 alien>string >>mount-from + ] + } cleave ; + +M: macosx file-system-info ( path -- file-system-info ) + normalize-path + "statfs64" tuck statfs64 io-error + statfs64>file-system-info ; diff --git a/basis/unix/statfs/statfs-tests.factor b/basis/unix/statfs/statfs-tests.factor new file mode 100644 index 0000000000..39bc77fc87 --- /dev/null +++ b/basis/unix/statfs/statfs-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test unix.statfs ; +IN: unix.statfs.tests diff --git a/basis/unix/statfs/statfs.factor b/basis/unix/statfs/statfs.factor new file mode 100644 index 0000000000..0d99b57faf --- /dev/null +++ b/basis/unix/statfs/statfs.factor @@ -0,0 +1,31 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: sequences system vocabs.loader combinators accessors +kernel math.order sorting ; +IN: unix.statfs + +TUPLE: mounted block-size io-size blocks blocks-free +blocks-available files files-free file-system-id owner type +flags filesystem-subtype file-system-type-name mount-on +mount-from ; + +HOOK: mounted* os ( -- array ) +HOOK: mounted-struct>mounted os ( byte-array -- mounted ) + +TUPLE: file-system-info root-directory total-free-size total-size ; + +: mounted ( -- array ) + mounted* [ mounted-struct>mounted ] map ; + +: mounted-drive ( path -- mounted/f ) + mounted + [ [ mount-on>> ] bi@ <=> ] sort + [ mount-on>> head? ] with find nip ; + +os { + { linux [ "unix.statfs.linux" require ] } + { macosx [ "unix.statfs.macosx" require ] } + ! { freebsd [ "unix.statfs.freebsd" require ] } + ! { netbsd [ "unix.statfs.netbsd" require ] } + ! { openbsd [ "unix.statfs.openbsd" require ] } +} case From dc4a1bc902088239757213a62648cb1fdb03b0a2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 20 Oct 2008 01:14:07 -0500 Subject: [PATCH 34/35] fix netbsd stat struct --- basis/unix/bsd/netbsd/netbsd.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/unix/bsd/netbsd/netbsd.factor b/basis/unix/bsd/netbsd/netbsd.factor index 6c45811d51..9f9e9e5a71 100644 --- a/basis/unix/bsd/netbsd/netbsd.factor +++ b/basis/unix/bsd/netbsd/netbsd.factor @@ -14,11 +14,11 @@ C-STRUCT: addrinfo { "addrinfo*" "next" } ; C-STRUCT: dirent - { "ino_t" "d_fileno" } + { "__uint32_t" "d_fileno" } { "__uint16_t" "d_reclen" } - { "__uint16_t" "d_namlen" } { "__uint8_t" "d_type" } - { { "char" 512 } "d_name" } ; + { "__uint8_t" "d_namlen" } + { { "char" 256 } "d_name" } ; : DT_UNKNOWN 0 ; inline : DT_FIFO 1 ; inline From deb4526bd11823e8fbeb8904f21462d5ddde7f4d Mon Sep 17 00:00:00 2001 From: erg Date: Mon, 20 Oct 2008 01:55:40 -0500 Subject: [PATCH 35/35] ffi work --- basis/unix/stat/linux/64/64.factor | 64 ---------------------------- basis/unix/statfs/linux/linux.factor | 18 +++++--- 2 files changed, 12 insertions(+), 70 deletions(-) diff --git a/basis/unix/stat/linux/64/64.factor b/basis/unix/stat/linux/64/64.factor index 03791bc8bd..b9d48066fb 100644 --- a/basis/unix/stat/linux/64/64.factor +++ b/basis/unix/stat/linux/64/64.factor @@ -1,6 +1,5 @@ USING: kernel alien.syntax math sequences unix alien.c-types arrays accessors combinators ; - IN: unix.stat ! Ubuntu 7.10 64-bit @@ -30,35 +29,6 @@ FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ; : stat ( pathname buf -- int ) 1 -rot __xstat ; : lstat ( pathname buf -- int ) 1 -rot __lxstat ; -C-STRUCT: fstab - { "char*" "fs_spec" } - { "char*" "fs_file" } - { "char*" "fs_vfstype" } - { "char*" "fs_mntops" } - { "char*" "fs_type" } - { "int" "fs_freq" } - { "int" "fs_passno" } ; - -FUNCTION: fstab* getfsent ( ) ; -FUNCTION: fstab* getfsspec ( char* name ) ; -FUNCTION: fstab* getfsfile ( char* name ) ; -FUNCTION: int setfsent ( ) ; -FUNCTION: void endfsent ( ) ; - -TUPLE: fstab spec file vfstype mntops type freq passno ; - -: fstab-struct>fstab ( struct -- fstab ) - [ fstab new ] dip - { - [ fstab-fs_spec >>spec ] - [ fstab-fs_file >>file ] - [ fstab-fs_vfstype >>vfstype ] - [ fstab-fs_mntops >>mntops ] - [ fstab-fs_type >>type ] - [ fstab-fs_freq >>freq ] - [ fstab-fs_passno >>passno ] - } cleave ; - TYPEDEF: ssize_t __SWORD_TYPE TYPEDEF: ulonglong __fsblkcnt64_t TYPEDEF: ulonglong __fsfilcnt64_t @@ -76,38 +46,4 @@ C-STRUCT: statfs64 { "__SWORD_TYPE" "f_frsize" } { { "__SWORD_TYPE" 5 } "f_spare" } ; -TUPLE: statfs type bsize blocks bfree bavail files ffree fsid -namelen frsize spare ; - -: statfs-struct>statfs ( struct -- statfs ) - [ \ statfs new ] dip - { - [ statfs64-f_type >>type ] - [ statfs64-f_bsize >>bsize ] - [ statfs64-f_blocks >>blocks ] - [ statfs64-f_bfree >>bfree ] - [ statfs64-f_bavail >>bavail ] - [ statfs64-f_files >>files ] - [ statfs64-f_ffree >>ffree ] - [ statfs64-f_fsid >>fsid ] - [ statfs64-f_namelen >>namelen ] - [ statfs64-f_frsize >>frsize ] - [ statfs64-f_spare >>spare ] - } cleave ; - FUNCTION: int statfs64 ( char* path, statfs64* buf ) ; -: statfs ( path -- byte-array ) - "statfs64" [ statfs64 io-error ] keep ; - -: all-fstabs ( -- seq ) - setfsent io-error - [ getfsent dup ] [ fstab-struct>fstab ] [ drop ] produce endfsent ; - -C-STRUCT: mntent - { "char*" "mnt_fsname" } - { "char*" "mnt_dir" } - { "char*" "mnt_type" } - { "char*" "mnt_opts" } - { "int" "mnt_freq" } - { "int" "mnt_passno" } ; - diff --git a/basis/unix/statfs/linux/linux.factor b/basis/unix/statfs/linux/linux.factor index b758503ab5..44c32fd53d 100644 --- a/basis/unix/statfs/linux/linux.factor +++ b/basis/unix/statfs/linux/linux.factor @@ -1,15 +1,20 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types combinators kernel ; +USING: alien.c-types combinators kernel io.files unix.stat +math accessors system unix io.backend ; IN: unix.statfs.linux TUPLE: linux-file-system-info < file-system-info type bsize blocks bfree bavail files ffree fsid namelen frsize spare ; -: statfs-struct>statfs ( struct -- statfs ) - [ \ statfs new ] dip +: statfs>file-system-info ( struct -- statfs ) + [ \ linux-file-system-info new ] dip { + [ + [ statfs64-f_bsize ] + [ statfs64-f_bavail ] bi * >>free-space + ] [ statfs64-f_type >>type ] [ statfs64-f_bsize >>bsize ] [ statfs64-f_blocks >>blocks ] @@ -23,6 +28,7 @@ namelen frsize spare ; [ statfs64-f_spare >>spare ] } cleave ; -: statfs ( path -- byte-array ) - "statfs64" [ statfs64 io-error ] keep ; - +M: linux file-system-info ( path -- byte-array ) + normalize-path + "statfs64" tuck statfs64 io-error + statfs>file-system-info ;