From da3936a162b7f99a51799ed3ec5ef516fcb342a4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 30 Nov 2008 17:32:55 -0600 Subject: [PATCH 01/33] fix netbsd file-system-info --- basis/io/unix/files/netbsd/netbsd.factor | 43 +++++++++++++++++++++--- basis/unix/statvfs/netbsd/netbsd.factor | 2 +- 2 files changed, 40 insertions(+), 5 deletions(-) diff --git a/basis/io/unix/files/netbsd/netbsd.factor b/basis/io/unix/files/netbsd/netbsd.factor index 429833a444..1bd8ba4f67 100644 --- a/basis/io/unix/files/netbsd/netbsd.factor +++ b/basis/io/unix/files/netbsd/netbsd.factor @@ -2,13 +2,48 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien.syntax kernel unix.stat math unix combinators system io.backend accessors alien.c-types -io.encodings.utf8 alien.strings unix.types unix.statfs io.files ; +io.encodings.utf8 alien.strings unix.types unix.statfs +io.unix.files io.files unix.statvfs.netbsd ; IN: io.unix.files.netbsd TUPLE: netbsd-file-system-info < unix-file-system-info -owner io-size blocks-reserved -sync-reads sync-writes async-reads async-writes -fsidx fstype mnotonname mntfromname mount-from spare ; +blocks-reserved files-reserved +owner io-size +sync-reads sync-writes +async-reads async-writes +idx mount-from spare ; + +M: netbsd new-file-system-info netbsd-file-system-info new ; M: netbsd file-system-statvfs "statvfs" tuck statvfs io-error ; + +M: netbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info' ) + { + [ statvfs-f_flag >>flags ] + [ statvfs-f_bsize >>block-size ] + [ statvfs-f_frsize >>preferred-block-size ] + [ statvfs-f_iosize >>io-size ] + [ statvfs-f_blocks >>blocks ] + [ statvfs-f_bfree >>blocks-free ] + [ statvfs-f_bavail >>blocks-available ] + [ statvfs-f_bresvd >>blocks-reserved ] + [ statvfs-f_files >>files ] + [ statvfs-f_ffree >>files-free ] + [ statvfs-f_favail >>files-available ] + [ statvfs-f_fresvd >>files-reserved ] + [ statvfs-f_syncreads >>sync-reads ] + [ statvfs-f_syncwrites >>sync-writes ] + [ statvfs-f_asyncreads >>async-reads ] + [ statvfs-f_asyncwrites >>async-writes ] + [ statvfs-f_fsidx >>idx ] + [ statvfs-f_fsid >>id ] + [ statvfs-f_namemax >>name-max ] + [ statvfs-f_owner >>owner ] + [ statvfs-f_spare >>spare ] + [ statvfs-f_fstypename alien>native-string >>type ] + [ statvfs-f_mntonname alien>native-string >>mount-point ] + [ statvfs-f_mntfromname alien>native-string >>device-name ] + } cleave ; + +FUNCTION: int statvfs ( char* path, statvfs* buf ) ; diff --git a/basis/unix/statvfs/netbsd/netbsd.factor b/basis/unix/statvfs/netbsd/netbsd.factor index e67a74de63..cf575c74b1 100644 --- a/basis/unix/statvfs/netbsd/netbsd.factor +++ b/basis/unix/statvfs/netbsd/netbsd.factor @@ -32,4 +32,4 @@ C-STRUCT: statvfs { { "char" _VFS_MNAMELEN } "f_mntonname" } { { "char" _VFS_MNAMELEN } "f_mntfromname" } ; -FUNCTION: int statvfs ( char* path, statvfs *buf ) ; +FUNCTION: int statvfs ( char* path, statvfs* buf ) ; From 1f7b5ef6d0eab5deb76d4a351c5692c76b11cc47 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 1 Dec 2008 14:04:31 -0600 Subject: [PATCH 02/33] redo most of statfs and statvfs --- basis/unix/statfs/freebsd/freebsd.factor | 29 -------- basis/unix/statfs/linux/32/32.factor | 46 ------------ basis/unix/statfs/linux/32/authors.txt | 1 - basis/unix/statfs/linux/64/64.factor | 50 ------------- basis/unix/statfs/linux/64/authors.txt | 1 - basis/unix/statfs/linux/linux.factor | 47 ++++--------- basis/unix/statfs/macosx/macosx.factor | 49 +------------ basis/unix/statfs/netbsd/netbsd.factor | 70 ------------------- basis/unix/statfs/openbsd/32/32.factor | 26 ------- basis/unix/statfs/openbsd/32/authors.txt | 1 - basis/unix/statfs/openbsd/64/64.factor | 32 --------- basis/unix/statfs/openbsd/64/authors.txt | 1 - basis/unix/statfs/openbsd/authors.txt | 1 - basis/unix/statfs/openbsd/openbsd.factor | 53 -------------- basis/unix/statfs/statfs.factor | 2 - basis/unix/statvfs/authors.txt | 1 + basis/unix/statvfs/freebsd/authors.txt | 1 + basis/unix/statvfs/freebsd/freebsd.factor | 23 ++++++ basis/unix/statvfs/linux/authors.txt | 1 + basis/unix/statvfs/linux/linux.factor | 31 ++++++++ .../linux/32 => statvfs/linux}/tags.txt | 0 basis/unix/statvfs/macosx/authors.txt | 1 + basis/unix/statvfs/macosx/macosx.factor | 23 ++++++ .../linux/64 => statvfs/macosx}/tags.txt | 0 basis/unix/statvfs/netbsd/authors.txt | 1 + basis/unix/statvfs/netbsd/netbsd.factor | 35 ++++++++++ .../openbsd/32 => statvfs/netbsd}/tags.txt | 0 basis/unix/statvfs/openbsd/authors.txt | 1 + basis/unix/statvfs/openbsd/openbsd.factor | 22 ++++++ .../openbsd/64 => statvfs/openbsd}/tags.txt | 0 basis/unix/statvfs/statvfs.factor | 12 ++++ .../unix/{statfs/openbsd => statvfs}/tags.txt | 0 32 files changed, 166 insertions(+), 395 deletions(-) delete mode 100644 basis/unix/statfs/linux/32/32.factor delete mode 100644 basis/unix/statfs/linux/32/authors.txt delete mode 100644 basis/unix/statfs/linux/64/64.factor delete mode 100644 basis/unix/statfs/linux/64/authors.txt delete mode 100644 basis/unix/statfs/openbsd/32/32.factor delete mode 100644 basis/unix/statfs/openbsd/32/authors.txt delete mode 100644 basis/unix/statfs/openbsd/64/64.factor delete mode 100644 basis/unix/statfs/openbsd/64/authors.txt delete mode 100644 basis/unix/statfs/openbsd/authors.txt delete mode 100644 basis/unix/statfs/openbsd/openbsd.factor create mode 100644 basis/unix/statvfs/authors.txt create mode 100644 basis/unix/statvfs/freebsd/authors.txt create mode 100644 basis/unix/statvfs/freebsd/freebsd.factor create mode 100644 basis/unix/statvfs/linux/authors.txt create mode 100644 basis/unix/statvfs/linux/linux.factor rename basis/unix/{statfs/linux/32 => statvfs/linux}/tags.txt (100%) create mode 100644 basis/unix/statvfs/macosx/authors.txt create mode 100644 basis/unix/statvfs/macosx/macosx.factor rename basis/unix/{statfs/linux/64 => statvfs/macosx}/tags.txt (100%) create mode 100644 basis/unix/statvfs/netbsd/authors.txt create mode 100644 basis/unix/statvfs/netbsd/netbsd.factor rename basis/unix/{statfs/openbsd/32 => statvfs/netbsd}/tags.txt (100%) create mode 100644 basis/unix/statvfs/openbsd/authors.txt create mode 100644 basis/unix/statvfs/openbsd/openbsd.factor rename basis/unix/{statfs/openbsd/64 => statvfs/openbsd}/tags.txt (100%) create mode 100644 basis/unix/statvfs/statvfs.factor rename basis/unix/{statfs/openbsd => statvfs}/tags.txt (100%) diff --git a/basis/unix/statfs/freebsd/freebsd.factor b/basis/unix/statfs/freebsd/freebsd.factor index b6179a4ad7..5496bbe1ba 100644 --- a/basis/unix/statfs/freebsd/freebsd.factor +++ b/basis/unix/statfs/freebsd/freebsd.factor @@ -22,32 +22,3 @@ C-STRUCT: statvfs { "ulong" "f_namemax" } ; FUNCTION: int statvfs ( char* path, statvfs* buf ) ; - -TUPLE: freebsd-file-system-info < file-system-info -bavail bfree blocks favail ffree files -bsize flag frsize fsid namemax ; - -M: freebsd >file-system-info ( struct -- statfs ) - [ \ freebsd-file-system-info new ] dip - { - [ - [ statvfs-f_bsize ] - [ statvfs-f_bavail ] bi * >>free-space - ] - [ statvfs-f_bavail >>bavail ] - [ statvfs-f_bfree >>bfree ] - [ statvfs-f_blocks >>blocks ] - [ statvfs-f_favail >>favail ] - [ statvfs-f_ffree >>ffree ] - [ statvfs-f_files >>files ] - [ statvfs-f_bsize >>bsize ] - [ statvfs-f_flag >>flag ] - [ statvfs-f_frsize >>frsize ] - [ statvfs-f_fsid >>fsid ] - [ statvfs-f_namemax >>namemax ] - } cleave ; - -M: freebsd file-system-info ( path -- byte-array ) - normalize-path - "statvfs" tuck statvfs io-error - >file-system-info ; diff --git a/basis/unix/statfs/linux/32/32.factor b/basis/unix/statfs/linux/32/32.factor deleted file mode 100644 index fb8c6b5035..0000000000 --- a/basis/unix/statfs/linux/32/32.factor +++ /dev/null @@ -1,46 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types combinators kernel unix.stat -math accessors system unix io.backend layouts vocabs.loader -alien.syntax unix.statfs io.files ; -IN: unix.statfs.linux - -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" } ; - -FUNCTION: int statfs ( char* path, statfs* buf ) ; - -TUPLE: linux32-file-system-info < file-system-info -bsize blocks bfree bavail files ffree fsid namelen -frsize spare ; - -M: linux >file-system-info ( struct -- statfs ) - [ \ linux32-file-system-info new ] dip - { - [ - [ statfs-f_bsize ] - [ statfs-f_bavail ] bi * >>free-space - ] - [ statfs-f_type >>type ] - [ statfs-f_bsize >>bsize ] - [ statfs-f_blocks >>blocks ] - [ statfs-f_bfree >>bfree ] - [ statfs-f_bavail >>bavail ] - [ statfs-f_files >>files ] - [ statfs-f_ffree >>ffree ] - [ statfs-f_fsid >>fsid ] - [ statfs-f_namelen >>namelen ] - } cleave ; - -M: linux file-system-info ( path -- byte-array ) - normalize-path - "statfs" tuck statfs io-error - >file-system-info ; diff --git a/basis/unix/statfs/linux/32/authors.txt b/basis/unix/statfs/linux/32/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/basis/unix/statfs/linux/32/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/linux/64/64.factor b/basis/unix/statfs/linux/64/64.factor deleted file mode 100644 index e9cd5576aa..0000000000 --- a/basis/unix/statfs/linux/64/64.factor +++ /dev/null @@ -1,50 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types combinators kernel unix.stat -math accessors system unix io.backend layouts vocabs.loader -alien.syntax unix.statfs io.files ; -IN: unix.statfs.linux - -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" } ; - -FUNCTION: int statfs64 ( char* path, statfs64* buf ) ; - -TUPLE: linux64-file-system-info < file-system-info -bsize blocks bfree bavail files ffree fsid namelen -frsize spare ; - -M: linux >file-system-info ( struct -- statfs ) - [ \ linux64-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 ] - [ 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 ; - -M: linux file-system-info ( path -- byte-array ) - normalize-path - "statfs64" tuck statfs64 io-error - >file-system-info ; diff --git a/basis/unix/statfs/linux/64/authors.txt b/basis/unix/statfs/linux/64/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/basis/unix/statfs/linux/64/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/linux/linux.factor b/basis/unix/statfs/linux/linux.factor index 43d5a99cd1..eb587e3286 100644 --- a/basis/unix/statfs/linux/linux.factor +++ b/basis/unix/statfs/linux/linux.factor @@ -6,38 +6,17 @@ sequences csv io.streams.string io.encodings.utf8 namespaces unix.statfs io.files ; IN: unix.statfs.linux -cell-bits { - { 32 [ "unix.statfs.linux.32" require ] } - { 64 [ "unix.statfs.linux.64" require ] } -} case +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: mtab-entry file-system-name mount-point type options -frequency pass-number ; - -: mtab-csv>mtab-entry ( csv -- mtab-entry ) - [ mtab-entry new ] dip - { - [ first >>file-system-name ] - [ second >>mount-point ] - [ third >>type ] - [ fourth csv first >>options ] - [ 4 swap nth >>frequency ] - [ 5 swap nth >>pass-number ] - } cleave ; - -: parse-mtab ( -- array ) - [ - "/etc/mtab" utf8 - CHAR: \s delimiter set csv - ] with-scope - [ mtab-csv>mtab-entry ] map ; - -M: linux file-systems - parse-mtab [ - [ mount-point>> file-system-info ] keep - { - [ file-system-name>> >>device-name ] - [ mount-point>> >>mount-point ] - [ type>> >>type ] - } cleave - ] map ; +FUNCTION: int statfs64 ( char* path, statfs64* buf ) ; diff --git a/basis/unix/statfs/macosx/macosx.factor b/basis/unix/statfs/macosx/macosx.factor index 7c30c4b9d4..fcdbb1ee87 100644 --- a/basis/unix/statfs/macosx/macosx.factor +++ b/basis/unix/statfs/macosx/macosx.factor @@ -3,7 +3,7 @@ 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 -math.bitwise alien.syntax ; +math.bitwise alien.syntax io.unix.files ; IN: unix.statfs.macosx : MNT_RDONLY HEX: 00000001 ; inline @@ -116,50 +116,3 @@ C-STRUCT: statfs64 FUNCTION: int statfs64 ( char* path, statfs64* buf ) ; FUNCTION: int getmntinfo64 ( statfs64** mntbufp, int flags ) ; - - -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-id flags filesystem-subtype ; - -M: macosx file-systems ( -- array ) - f dup 0 getmntinfo64 dup io-error - [ *void* ] dip - "statfs64" heap-size [ * memory>byte-array ] keep group - [ >file-system-info ] map ; - -M: macosx >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-point ] - [ 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-id ] - [ statfs64-f_flags >>flags ] - [ statfs64-f_fssubtype >>filesystem-subtype ] - [ - statfs64-f_fstypename utf8 alien>string - >>type - ] - [ - statfs64-f_mntfromname - utf8 alien>string >>device-name - ] - } cleave ; - -M: macosx file-system-info ( path -- file-system-info ) - normalize-path - "statfs64" tuck statfs64 io-error - >file-system-info ; diff --git a/basis/unix/statfs/netbsd/netbsd.factor b/basis/unix/statfs/netbsd/netbsd.factor index ad7c161713..30f258ca8d 100644 --- a/basis/unix/statfs/netbsd/netbsd.factor +++ b/basis/unix/statfs/netbsd/netbsd.factor @@ -5,74 +5,4 @@ combinators system io.backend accessors alien.c-types io.encodings.utf8 alien.strings unix.types unix.statfs io.files ; IN: unix.statfs.netbsd -: _VFS_NAMELEN 32 ; inline -: _VFS_MNAMELEN 1024 ; inline -C-STRUCT: statvfs - { "ulong" "f_flag" } - { "ulong" "f_bsize" } - { "ulong" "f_frsize" } - { "ulong" "f_iosize" } - { "fsblkcnt_t" "f_blocks" } - { "fsblkcnt_t" "f_bfree" } - { "fsblkcnt_t" "f_bavail" } - { "fsblkcnt_t" "f_bresvd" } - { "fsfilcnt_t" "f_files" } - { "fsfilcnt_t" "f_ffree" } - { "fsfilcnt_t" "f_favail" } - { "fsfilcnt_t" "f_fresvd" } - { "uint64_t" "f_syncreads" } - { "uint64_t" "f_syncwrites" } - { "uint64_t" "f_asyncreads" } - { "uint64_t" "f_asyncwrites" } - { "fsid_t" "f_fsidx" } - { "ulong" "f_fsid" } - { "ulong" "f_namemax" } - { "uid_t" "f_owner" } - { { "uint32_t" 4 } "f_spare" } - { { "char" _VFS_NAMELEN } "f_fstypename" } - { { "char" _VFS_MNAMELEN } "f_mntonname" } - { { "char" _VFS_MNAMELEN } "f_mntfromname" } ; - -FUNCTION: int statvfs ( char* path, statvfs *buf ) ; - -TUPLE: netbsd-file-system-info < file-system-info -flag bsize frsize io-size -blocks blocks-free blocks-available blocks-reserved -files ffree sync-reads sync-writes async-reads async-writes -fsidx fsid namemax owner spare fstype mnotonname mntfromname -file-system-type-name mount-from ; - -M: netbsd >file-system-info ( byte-array -- netbsd-file-system-info ) - [ \ netbsd-file-system-info new ] dip - { - [ - [ statvfs-f_bsize ] - [ statvfs-f_bavail ] bi * >>free-space - ] - [ statvfs-f_flag >>flag ] - [ statvfs-f_bsize >>bsize ] - [ statvfs-f_frsize >>frsize ] - [ statvfs-f_iosize >>io-size ] - [ statvfs-f_blocks >>blocks ] - [ statvfs-f_bfree >>blocks-free ] - [ statvfs-f_favail >>blocks-available ] - [ statvfs-f_fresvd >>blocks-reserved ] - [ statvfs-f_files >>files ] - [ statvfs-f_ffree >>ffree ] - [ statvfs-f_syncreads >>sync-reads ] - [ statvfs-f_syncwrites >>sync-writes ] - [ statvfs-f_asyncreads >>async-reads ] - [ statvfs-f_asyncwrites >>async-writes ] - [ statvfs-f_fsidx >>fsidx ] - [ statvfs-f_namemax >>namemax ] - [ statvfs-f_owner >>owner ] - [ statvfs-f_spare >>spare ] - [ statvfs-f_fstypename utf8 alien>string >>file-system-type-name ] - [ statvfs-f_mntonname utf8 alien>string >>mount-point ] - [ statvfs-f_mntfromname utf8 alien>string >>mount-from ] - } cleave ; - -M: netbsd file-system-info - normalize-path "statvfs" tuck statvfs io-error - >file-system-info ; diff --git a/basis/unix/statfs/openbsd/32/32.factor b/basis/unix/statfs/openbsd/32/32.factor deleted file mode 100644 index aa1e8425dc..0000000000 --- a/basis/unix/statfs/openbsd/32/32.factor +++ /dev/null @@ -1,26 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax kernel unix ; -IN: unix.statfs.openbsd.32 - -: MFSNAMELEN 16 ; inline -: MNAMELEN 90 ; inline - -C-STRUCT: statfs - { "u_int32_t" "f_flags" } - { "int32_t" "f_bsize" } - { "u_int32_t" "f_iosize" } - { "u_int32_t" "f_blocks" } - { "u_int32_t" "f_bfree" } - { "int32_t" "f_bavail" } - { "u_int32_t" "f_files" } - { "u_int32_t" "f_ffree" } - { "fsid_t" "f_fsid" } - { "uid_t" "f_owner" } - { "u_int32_t" "f_syncwrites" } - { "u_int32_t" "f_asyncwrites" } - { "u_int32_t" "f_ctime" } - { { "u_int32_t" 3 } "f_spare" } - { { "char" MFSNAMELEN } "f_fstypename" } - { { "char" MNAMELEN } "f_mntonname" } - { { "char" MNAMELEN } "f_mntfromname" } ; diff --git a/basis/unix/statfs/openbsd/32/authors.txt b/basis/unix/statfs/openbsd/32/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/basis/unix/statfs/openbsd/32/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/openbsd/64/64.factor b/basis/unix/statfs/openbsd/64/64.factor deleted file mode 100644 index fd40fba033..0000000000 --- a/basis/unix/statfs/openbsd/64/64.factor +++ /dev/null @@ -1,32 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax unix ; -IN: unix.statfs.openbsd.64 - -: MFSNAMELEN 16 ; inline -: MNAMELEN 90 ; inline - -C-STRUCT: statfss - { "u_int32_t" "f_flags" } - { "u_int32_t" "f_bsize" } - { "u_int32_t" "f_iosize" } - { "u_int64_t" "f_blocks" } - { "u_int64_t" "f_bfree" } - { "int64_t" "f_bavail" } - { "u_int64_t" "f_files" } - { "u_int64_t" "f_ffree" } - { "int64_t" "f_favail" } - { "u_int64_t" "f_syncwrites" } - { "u_int64_t" "f_syncreads" } - { "u_int64_t" "f_asyncwrites" } - { "u_int64_t" "f_asyncreads" } - { "fsid_t" "f_fsid" } - { "u_int32_t" "f_namemax" } - { "uid_t" "f_owner" } - { "u_int32_t" "f_ctime" } - { { "u_int32_t" 3 } " f_spare" } - { { "char" MFSNAMELEN } "f_fstypename" } - { { "char" MNAMELEN } "f_mntonname" } - { { "char" MNAMELEN } "f_mntfromname" } - { { "char" 512 } "mount_info" } ; - ! { "mount_info" "mount_info" } ; diff --git a/basis/unix/statfs/openbsd/64/authors.txt b/basis/unix/statfs/openbsd/64/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/basis/unix/statfs/openbsd/64/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/openbsd/authors.txt b/basis/unix/statfs/openbsd/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/basis/unix/statfs/openbsd/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/openbsd/openbsd.factor b/basis/unix/statfs/openbsd/openbsd.factor deleted file mode 100644 index fa86ef2bc2..0000000000 --- a/basis/unix/statfs/openbsd/openbsd.factor +++ /dev/null @@ -1,53 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax accessors combinators kernel -unix.types math system io.backend alien.c-types unix -unix.statfs io.files ; -IN: unix.statfs.openbsd - -C-STRUCT: statvfs - { "ulong" "f_bsize" } - { "ulong" "f_frsize" } - { "fsblkcnt_t" "f_blocks" } - { "fsblkcnt_t" "f_bfree" } - { "fsblkcnt_t" "f_bavail" } - { "fsfilcnt_t" "f_files" } - { "fsfilcnt_t" "f_ffree" } - { "fsfilcnt_t" "f_favail" } - { "ulong" "f_fsid" } - { "ulong" "f_flag" } - { "ulong" "f_namemax" } ; - -: ST_RDONLY 1 ; inline -: ST_NOSUID 2 ; inline - -FUNCTION: int statvfs ( char* path, statvfs* buf ) ; - -TUPLE: openbsd-file-system-info < file-system-info -bsize frsize blocks bfree bavail files ffree favail -fsid flag namemax ; - -M: openbsd >file-system-info ( struct -- statfs ) - [ \ openbsd-file-system-info new ] dip - { - [ - [ statvfs-f_bsize ] - [ statvfs-f_bavail ] bi * >>free-space - ] - [ statvfs-f_bsize >>bsize ] - [ statvfs-f_frsize >>frsize ] - [ statvfs-f_blocks >>blocks ] - [ statvfs-f_bfree >>bfree ] - [ statvfs-f_bavail >>bavail ] - [ statvfs-f_files >>files ] - [ statvfs-f_ffree >>ffree ] - [ statvfs-f_favail >>favail ] - [ statvfs-f_fsid >>fsid ] - [ statvfs-f_flag >>flag ] - [ statvfs-f_namemax >>namemax ] - } cleave ; - -M: openbsd file-system-info ( path -- byte-array ) - normalize-path - "statvfs" tuck statvfs io-error - >file-system-info ; diff --git a/basis/unix/statfs/statfs.factor b/basis/unix/statfs/statfs.factor index 0397507fce..bc7b199705 100644 --- a/basis/unix/statfs/statfs.factor +++ b/basis/unix/statfs/statfs.factor @@ -4,8 +4,6 @@ USING: sequences system vocabs.loader combinators accessors kernel math.order sorting ; IN: unix.statfs -HOOK: >file-system-info os ( struct -- statfs ) - os { { linux [ "unix.statfs.linux" require ] } { macosx [ "unix.statfs.macosx" require ] } diff --git a/basis/unix/statvfs/authors.txt b/basis/unix/statvfs/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/unix/statvfs/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/unix/statvfs/freebsd/authors.txt b/basis/unix/statvfs/freebsd/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/unix/statvfs/freebsd/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/unix/statvfs/freebsd/freebsd.factor b/basis/unix/statvfs/freebsd/freebsd.factor new file mode 100644 index 0000000000..7d1a6afb61 --- /dev/null +++ b/basis/unix/statvfs/freebsd/freebsd.factor @@ -0,0 +1,23 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax ; +IN: unix.statvfs.freebsd + +C-STRUCT: statvfs + { "fsblkcnt_t" "f_bavail" } + { "fsblkcnt_t" "f_bfree" } + { "fsblkcnt_t" "f_blocks" } + { "fsfilcnt_t" "f_favail" } + { "fsfilcnt_t" "f_ffree" } + { "fsfilcnt_t" "f_files" } + { "ulong" "f_bsize" } + { "ulong" "f_flag" } + { "ulong" "f_frsize" } + { "ulong" "f_fsid" } + { "ulong" "f_namemax" } ; + +! Flags +: ST_RDONLY HEX: 1 ; inline ! Read-only file system +: ST_NOSUID HEX: 2 ; inline ! Does not honor setuid/setgid + +FUNCTION: int statvfs ( char* path, statvfs* buf ) ; diff --git a/basis/unix/statvfs/linux/authors.txt b/basis/unix/statvfs/linux/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/unix/statvfs/linux/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/unix/statvfs/linux/linux.factor b/basis/unix/statvfs/linux/linux.factor new file mode 100644 index 0000000000..008692a501 --- /dev/null +++ b/basis/unix/statvfs/linux/linux.factor @@ -0,0 +1,31 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax ; +IN: unix.statvfs.linux + +C-STRUCT: statvfs64 + { "ulong" "f_bsize" } + { "ulong" "f_frsize" } + { "__fsblkcnt64_t" "f_blocks" } + { "__fsblkcnt64_t" "f_bfree" } + { "__fsblkcnt64_t" "f_bavail" } + { "__fsfilcnt64_t" "f_files" } + { "__fsfilcnt64_t" "f_ffree" } + { "__fsfilcnt64_t" "f_favail" } + { "ulong" "f_fsid" } + { "ulong" "f_flag" } + { "ulong" f_namemax" } + { { "int" 6 } "__f_spare" } ; + +FUNCTION: int statvfs64 ( char* path, statvfs64* buf ) ; + +: ST_RDONLY 1 ; inline ! Mount read-only. +: ST_NOSUID 2 ; inline ! Ignore suid and sgid bits. +: ST_NODEV 4 ; inline ! Disallow access to device special files. +: ST_NOEXEC 8 ; inline ! Disallow program execution. +: ST_SYNCHRONOUS 16 ; inline ! Writes are synced at once. +: ST_MANDLOCK 64 ; inline ! Allow mandatory locks on an FS. +: ST_WRITE 128 ; inline ! Write on file/directory/symlink. +: ST_APPEND 256 ; inline ! Append-only file. +: ST_IMMUTABLE 512 ; inline ! Immutable file. +: ST_NOATIME 1024 ; inline ! Do not update access times. diff --git a/basis/unix/statfs/linux/32/tags.txt b/basis/unix/statvfs/linux/tags.txt similarity index 100% rename from basis/unix/statfs/linux/32/tags.txt rename to basis/unix/statvfs/linux/tags.txt diff --git a/basis/unix/statvfs/macosx/authors.txt b/basis/unix/statvfs/macosx/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/unix/statvfs/macosx/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/unix/statvfs/macosx/macosx.factor b/basis/unix/statvfs/macosx/macosx.factor new file mode 100644 index 0000000000..7078ff9f33 --- /dev/null +++ b/basis/unix/statvfs/macosx/macosx.factor @@ -0,0 +1,23 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax ; +IN: unix.statvfs.macosx + +C-STRUCT: statvfs + { "ulong" "f_bsize" } + { "ulong" "f_frsize" } + { "fsblkcnt_t" "f_blocks" } + { "fsblkcnt_t" "f_bfree" } + { "fsblkcnt_t" "f_bavail" } + { "fsfilcnt_t" "f_files" } + { "fsfilcnt_t" "f_ffree" } + { "fsfilcnt_t" "f_favail" } + { "ulong" "f_fsid" } + { "ulong" "f_flag" } + { "ulong" "f_namemax" } ; + +! Flags +: ST_RDONLY HEX: 1 ; inline ! Read-only file system +: ST_NOSUID HEX: 2 ; inline ! Does not honor setuid/setgid + +FUNCTION: int statvfs ( char* path, statvfs* buf ) ; diff --git a/basis/unix/statfs/linux/64/tags.txt b/basis/unix/statvfs/macosx/tags.txt similarity index 100% rename from basis/unix/statfs/linux/64/tags.txt rename to basis/unix/statvfs/macosx/tags.txt diff --git a/basis/unix/statvfs/netbsd/authors.txt b/basis/unix/statvfs/netbsd/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/unix/statvfs/netbsd/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/unix/statvfs/netbsd/netbsd.factor b/basis/unix/statvfs/netbsd/netbsd.factor new file mode 100644 index 0000000000..e67a74de63 --- /dev/null +++ b/basis/unix/statvfs/netbsd/netbsd.factor @@ -0,0 +1,35 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax ; +IN: unix.statvfs.netbsd + +: _VFS_NAMELEN 32 ; inline +: _VFS_MNAMELEN 1024 ; inline + +C-STRUCT: statvfs + { "ulong" "f_flag" } + { "ulong" "f_bsize" } + { "ulong" "f_frsize" } + { "ulong" "f_iosize" } + { "fsblkcnt_t" "f_blocks" } + { "fsblkcnt_t" "f_bfree" } + { "fsblkcnt_t" "f_bavail" } + { "fsblkcnt_t" "f_bresvd" } + { "fsfilcnt_t" "f_files" } + { "fsfilcnt_t" "f_ffree" } + { "fsfilcnt_t" "f_favail" } + { "fsfilcnt_t" "f_fresvd" } + { "uint64_t" "f_syncreads" } + { "uint64_t" "f_syncwrites" } + { "uint64_t" "f_asyncreads" } + { "uint64_t" "f_asyncwrites" } + { "fsid_t" "f_fsidx" } + { "ulong" "f_fsid" } + { "ulong" "f_namemax" } + { "uid_t" "f_owner" } + { { "uint32_t" 4 } "f_spare" } + { { "char" _VFS_NAMELEN } "f_fstypename" } + { { "char" _VFS_MNAMELEN } "f_mntonname" } + { { "char" _VFS_MNAMELEN } "f_mntfromname" } ; + +FUNCTION: int statvfs ( char* path, statvfs *buf ) ; diff --git a/basis/unix/statfs/openbsd/32/tags.txt b/basis/unix/statvfs/netbsd/tags.txt similarity index 100% rename from basis/unix/statfs/openbsd/32/tags.txt rename to basis/unix/statvfs/netbsd/tags.txt diff --git a/basis/unix/statvfs/openbsd/authors.txt b/basis/unix/statvfs/openbsd/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/unix/statvfs/openbsd/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/unix/statvfs/openbsd/openbsd.factor b/basis/unix/statvfs/openbsd/openbsd.factor new file mode 100644 index 0000000000..3f9353f926 --- /dev/null +++ b/basis/unix/statvfs/openbsd/openbsd.factor @@ -0,0 +1,22 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax ; +IN: unix.statvfs.openbsd + +C-STRUCT: statvfs + { "ulong" "f_bsize" } + { "ulong" "f_frsize" } + { "fsblkcnt_t" "f_blocks" } + { "fsblkcnt_t" "f_bfree" } + { "fsblkcnt_t" "f_bavail" } + { "fsfilcnt_t" "f_files" } + { "fsfilcnt_t" "f_ffree" } + { "fsfilcnt_t" "f_favail" } + { "ulong" "f_fsid" } + { "ulong" "f_flag" } + { "ulong" "f_namemax" } ; + +: ST_RDONLY 1 ; inline +: ST_NOSUID 2 ; inline + +FUNCTION: int statvfs ( char* path, statvfs* buf ) ; diff --git a/basis/unix/statfs/openbsd/64/tags.txt b/basis/unix/statvfs/openbsd/tags.txt similarity index 100% rename from basis/unix/statfs/openbsd/64/tags.txt rename to basis/unix/statvfs/openbsd/tags.txt diff --git a/basis/unix/statvfs/statvfs.factor b/basis/unix/statvfs/statvfs.factor new file mode 100644 index 0000000000..e610140397 --- /dev/null +++ b/basis/unix/statvfs/statvfs.factor @@ -0,0 +1,12 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: combinators system vocabs.loader ; +IN: unix.statvfs + +os { + { linux [ "unix.statvfs.linux" require ] } + { macosx [ "unix.statvfs.macosx" require ] } + { freebsd [ "unix.statvfs.freebsd" require ] } + { netbsd [ "unix.statvfs.netbsd" require ] } + { openbsd [ "unix.statvfs.openbsd" require ] } +} case diff --git a/basis/unix/statfs/openbsd/tags.txt b/basis/unix/statvfs/tags.txt similarity index 100% rename from basis/unix/statfs/openbsd/tags.txt rename to basis/unix/statvfs/tags.txt From 2a34339e6579b2a03ed304e59603d4c8acd0a8e5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 1 Dec 2008 14:04:55 -0600 Subject: [PATCH 03/33] make a generic protocol for filling in the file-system-info obj in io.unix.files --- basis/io/unix/files/files.factor | 57 ++++++++++++++++-- basis/io/unix/files/freebsd/freebsd.factor | 24 ++++++++ basis/io/unix/files/freebsd/tags.txt | 1 + basis/io/unix/files/linux/linux.factor | 67 ++++++++++++++++++++++ basis/io/unix/files/linux/tags.txt | 1 + basis/io/unix/files/macosx/macosx.factor | 50 ++++++++++++++++ basis/io/unix/files/macosx/tags.txt | 1 + basis/io/unix/files/netbsd/netbsd.factor | 14 +++++ basis/io/unix/files/netbsd/tags.txt | 1 + basis/io/unix/files/openbsd/openbsd.factor | 24 ++++++++ basis/io/unix/files/openbsd/tags.txt | 1 + 11 files changed, 237 insertions(+), 4 deletions(-) create mode 100644 basis/io/unix/files/freebsd/freebsd.factor create mode 100644 basis/io/unix/files/freebsd/tags.txt create mode 100644 basis/io/unix/files/linux/linux.factor create mode 100644 basis/io/unix/files/linux/tags.txt create mode 100644 basis/io/unix/files/macosx/macosx.factor create mode 100644 basis/io/unix/files/macosx/tags.txt create mode 100644 basis/io/unix/files/netbsd/netbsd.factor create mode 100644 basis/io/unix/files/netbsd/tags.txt create mode 100644 basis/io/unix/files/openbsd/openbsd.factor create mode 100644 basis/io/unix/files/openbsd/tags.txt diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor index 9fa1727e16..d1fb059b77 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 fry io.encodings.utf8 alien.strings unix.statfs +environment fry io.encodings.utf8 alien.strings combinators.short-circuit ; IN: io.unix.files @@ -76,15 +76,64 @@ M: unix copy-file ( from to -- ) [ swap file-info permissions>> chmod io-error ] 2bi ; -HOOK: stat>file-info os ( stat -- file-info ) +TUPLE: unix-file-system-info < file-system-info +block-size preferred-block-size +blocks blocks-free blocks-available +files files-free files-available +name-max flags id ; -HOOK: stat>type os ( stat -- file-info ) +HOOK: new-file-system-info os ( -- file-system-info ) -HOOK: new-file-info os ( -- class ) +M: unix new-file-system-info ( -- ) unix-file-system-info new ; + +HOOK: file-system-statfs os ( path -- statfs ) + +M: unix file-system-statfs drop f ; + +HOOK: file-system-statvfs os ( path -- statvfs ) + +M: unix file-system-statvfs drop f ; + +HOOK: statfs>file-system-info os ( file-system-info statfs -- file-system-info' ) + +M: unix statfs>file-system-info drop ; + +HOOK: statvfs>file-system-info os ( file-system-info statvfs -- file-system-info' ) + +M: unix statvfs>file-system-info drop ; + +: file-system-calculations ( file-system-info -- file-system-info' ) + { + [ dup [ blocks-available>> ] [ block-size>> ] bi * >>free-space drop ] + [ dup [ blocks>> ] [ block-size>> ] bi * >>total-space drop ] + [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ] + [ ] + } cleave ; + +M: unix file-system-info + normalize-path + [ new-file-system-info ] dip + [ file-system-statfs statfs>file-system-info ] + [ file-system-statvfs statvfs>file-system-info ] bi + file-system-calculations ; + +os { + { linux [ "io.unix.files.linux" require ] } + { macosx [ "io.unix.files.macosx" require ] } + { freebsd [ "io.unix.files.freebsd" require ] } + { netbsd [ "io.unix.files.netbsd" require ] } + { openbsd [ "io.unix.files.openbsd" require ] } +} case TUPLE: unix-file-info < file-info uid gid dev ino nlink rdev blocks blocksize ; +HOOK: new-file-info os ( -- file-info ) + +HOOK: stat>file-info os ( stat -- file-info ) + +HOOK: stat>type os ( stat -- file-info ) + M: unix file-info ( path -- info ) normalize-path file-status stat>file-info ; diff --git a/basis/io/unix/files/freebsd/freebsd.factor b/basis/io/unix/files/freebsd/freebsd.factor new file mode 100644 index 0000000000..48dfd37584 --- /dev/null +++ b/basis/io/unix/files/freebsd/freebsd.factor @@ -0,0 +1,24 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax kernel unix math accessors +combinators system io.backend alien.c-types unix.statfs +io.files ; +IN: io.unix.files.freebsd + +M: freebsd file-system-statvfs ( path -- byte-array ) + "statvfs" tuck statvfs io-error ; + +M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info ) + { + [ statvfs-f_bavail >>blocks-available ] + [ statvfs-f_bfree >>blocks-free ] + [ statvfs-f_blocks >>blocks ] + [ statvfs-f_favail >>files-available ] + [ statvfs-f_ffree >>files-free ] + [ statvfs-f_files >>files ] + [ statvfs-f_bsize >>block-size ] + [ statvfs-f_flag >>flags ] + [ statvfs-f_frsize >>preferred-block-size ] + [ statvfs-f_fsid >>id ] + [ statvfs-f_namemax >>name-max ] + } cleave ; diff --git a/basis/io/unix/files/freebsd/tags.txt b/basis/io/unix/files/freebsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/files/freebsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/unix/files/linux/linux.factor b/basis/io/unix/files/linux/linux.factor new file mode 100644 index 0000000000..584015711f --- /dev/null +++ b/basis/io/unix/files/linux/linux.factor @@ -0,0 +1,67 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. + +IN: io.unix.files.linux + +TUPLE: linux-file-system-info < unix-file-system-info +namelen spare ; + +M: linux new-file-system-info unix-file-system-info new ; + +M: linux file-system-statfs ( path -- byte-array ) + "statfs64" tuck statfs64 io-error ; + +M: linux statfs>file-system-info ( struct -- statfs ) + { + [ statfs64-f_type >>type ] + [ statfs64-f_bsize >>block-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 >>id ] + [ statfs64-f_namelen >>namelen ] + [ statfs64-f_frsize >>preferred-block-size ] + [ statfs64-f_spare >>spare ] + } cleave ; + +M: linux file-system-statvfs ( path -- byte-array ) + "statvfs64" tuck statvfs64 io-error ; + +M: linux statvfs>file-system-info ( struct -- statfs ) + { + [ statvfs64-f_flag >>flags ] + [ statvfs64-f_namemax >>name-max ] + } cleave ; + +M: linux file-systems + parse-mtab [ + [ mount-point>> file-system-info ] keep + { + [ file-system-name>> >>device-name ] + [ mount-point>> >>mount-point ] + [ type>> >>type ] + } cleave + ] map ; + +TUPLE: mtab-entry file-system-name mount-point type options +frequency pass-number ; + +: mtab-csv>mtab-entry ( csv -- mtab-entry ) + [ mtab-entry new ] dip + { + [ first >>file-system-name ] + [ second >>mount-point ] + [ third >>type ] + [ fourth csv first >>options ] + [ 4 swap nth >>frequency ] + [ 5 swap nth >>pass-number ] + } cleave ; + +: parse-mtab ( -- array ) + [ + "/etc/mtab" utf8 + CHAR: \s delimiter set csv + ] with-scope + [ mtab-csv>mtab-entry ] map ; diff --git a/basis/io/unix/files/linux/tags.txt b/basis/io/unix/files/linux/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/files/linux/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/unix/files/macosx/macosx.factor b/basis/io/unix/files/macosx/macosx.factor new file mode 100644 index 0000000000..c5d12a012e --- /dev/null +++ b/basis/io/unix/files/macosx/macosx.factor @@ -0,0 +1,50 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types alien.strings combinators +grouping io.encodings.utf8 io.files kernel math sequences +system unix unix.statfs.macosx io.unix.files unix.statvfs.macosx ; +IN: io.unix.files.macosx + +TUPLE: macosx-file-system-info < unix-file-system-info +io-size owner type-id filesystem-subtype ; + +M: macosx file-systems ( -- array ) + f dup 0 getmntinfo64 dup io-error + [ *void* ] dip + "statfs64" heap-size [ * memory>byte-array ] keep group + [ [ new-file-system-info ] dip statfs>file-system-info ] map ; + +M: macosx new-file-system-info macosx-file-system-info new ; + +M: macosx file-system-statfs ( normalized-path -- statfs ) + "statfs64" tuck statfs64 io-error ; + +M: macosx file-system-statvfs ( normalized-path -- statvfs ) + "statvfs" tuck statvfs io-error ; + +M: macosx statfs>file-system-info ( file-system-info byte-array -- file-system-info' ) + { + [ 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 >>id ] + [ statfs64-f_owner >>owner ] + [ statfs64-f_type >>type-id ] + [ statfs64-f_flags >>flags ] + [ statfs64-f_fssubtype >>filesystem-subtype ] + [ statfs64-f_fstypename utf8 alien>string >>type ] + [ statfs64-f_mntonname utf8 alien>string >>mount-point ] + [ statfs64-f_mntfromname utf8 alien>string >>device-name ] + } cleave ; + +M: macosx statvfs>file-system-info ( file-system-info byte-array -- file-system-info' ) + { + [ statvfs-f_frsize >>preferred-block-size ] + [ statvfs-f_favail >>files-available ] + [ statvfs-f_namemax >>name-max ] + } cleave ; + diff --git a/basis/io/unix/files/macosx/tags.txt b/basis/io/unix/files/macosx/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/files/macosx/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/unix/files/netbsd/netbsd.factor b/basis/io/unix/files/netbsd/netbsd.factor new file mode 100644 index 0000000000..429833a444 --- /dev/null +++ b/basis/io/unix/files/netbsd/netbsd.factor @@ -0,0 +1,14 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax kernel unix.stat math unix +combinators system io.backend accessors alien.c-types +io.encodings.utf8 alien.strings unix.types unix.statfs io.files ; +IN: io.unix.files.netbsd + +TUPLE: netbsd-file-system-info < unix-file-system-info +owner io-size blocks-reserved +sync-reads sync-writes async-reads async-writes +fsidx fstype mnotonname mntfromname mount-from spare ; + +M: netbsd file-system-statvfs + "statvfs" tuck statvfs io-error ; diff --git a/basis/io/unix/files/netbsd/tags.txt b/basis/io/unix/files/netbsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/files/netbsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/unix/files/openbsd/openbsd.factor b/basis/io/unix/files/openbsd/openbsd.factor new file mode 100644 index 0000000000..d348d281fb --- /dev/null +++ b/basis/io/unix/files/openbsd/openbsd.factor @@ -0,0 +1,24 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax accessors combinators kernel +unix.types math system io.backend alien.c-types unix +unix.statfs io.files ; +IN: io.unix.files.openbsd + +M: openbsd >file-system-info ( file-system-info statvfs -- file-system-info' ) + { + [ statvfs-f_bsize >>block-size ] + [ statvfs-f_frsize >>preferred-block-size ] + [ statvfs-f_blocks >>blocks ] + [ statvfs-f_bfree >>blocks-free ] + [ statvfs-f_bavail >>blocks-avail ] + [ statvfs-f_files >>files ] + [ statvfs-f_ffree >>files-free ] + [ statvfs-f_favail >>files-available ] + [ statvfs-f_fsid >>id ] + [ statvfs-f_flag >>flags ] + [ statvfs-f_namemax >>name-max ] + } cleave ; + +M: openbsd file-system-statvfs ( normalized-path -- statvfs ) + "statvfs" tuck statvfs io-error ; diff --git a/basis/io/unix/files/openbsd/tags.txt b/basis/io/unix/files/openbsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/files/openbsd/tags.txt @@ -0,0 +1 @@ +unportable From 28e6d7d11617945a28bbce2aeffc08251f2ae0ed Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 1 Dec 2008 14:05:46 -0600 Subject: [PATCH 04/33] add more shared slots fo file-system-info --- core/io/files/files.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 7c7a2ece31..cd1c5d698c 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -187,7 +187,8 @@ SYMBOL: +unknown+ HOOK: file-systems os ( -- array ) -TUPLE: file-system-info device-name mount-point type free-space ; +TUPLE: file-system-info device-name mount-point type +free-space used-space total-space ; HOOK: file-system-info os ( path -- file-system-info ) From dfde2dfef36ec1604173ff26fbf18147815966f3 Mon Sep 17 00:00:00 2001 From: erg Date: Mon, 1 Dec 2008 16:28:22 -0600 Subject: [PATCH 05/33] fix file-system-info on linux --- basis/io/unix/files/linux/linux.factor | 27 ++++++++++++++------------ basis/unix/statfs/linux/linux.factor | 5 +---- basis/unix/statvfs/linux/linux.factor | 2 +- 3 files changed, 17 insertions(+), 17 deletions(-) diff --git a/basis/io/unix/files/linux/linux.factor b/basis/io/unix/files/linux/linux.factor index 584015711f..dd9abcbd1e 100644 --- a/basis/io/unix/files/linux/linux.factor +++ b/basis/io/unix/files/linux/linux.factor @@ -1,12 +1,15 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. - +USING: accessors alien.c-types alien.syntax combinators csv +io.encodings.utf8 io.files io.streams.string io.unix.files +kernel namespaces sequences system unix unix.statfs.linux +unix.statvfs.linux ; IN: io.unix.files.linux TUPLE: linux-file-system-info < unix-file-system-info namelen spare ; -M: linux new-file-system-info unix-file-system-info new ; +M: linux new-file-system-info linux-file-system-info new ; M: linux file-system-statfs ( path -- byte-array ) "statfs64" tuck statfs64 io-error ; @@ -35,16 +38,6 @@ M: linux statvfs>file-system-info ( struct -- statfs ) [ statvfs64-f_namemax >>name-max ] } cleave ; -M: linux file-systems - parse-mtab [ - [ mount-point>> file-system-info ] keep - { - [ file-system-name>> >>device-name ] - [ mount-point>> >>mount-point ] - [ type>> >>type ] - } cleave - ] map ; - TUPLE: mtab-entry file-system-name mount-point type options frequency pass-number ; @@ -65,3 +58,13 @@ frequency pass-number ; CHAR: \s delimiter set csv ] with-scope [ mtab-csv>mtab-entry ] map ; + +M: linux file-systems + parse-mtab [ + [ mount-point>> file-system-info ] keep + { + [ file-system-name>> >>device-name ] + [ mount-point>> >>mount-point ] + [ type>> >>type ] + } cleave + ] map ; diff --git a/basis/unix/statfs/linux/linux.factor b/basis/unix/statfs/linux/linux.factor index eb587e3286..6550ee572e 100644 --- a/basis/unix/statfs/linux/linux.factor +++ b/basis/unix/statfs/linux/linux.factor @@ -1,9 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types combinators kernel unix.stat -math accessors system unix io.backend layouts vocabs.loader -sequences csv io.streams.string io.encodings.utf8 namespaces -unix.statfs io.files ; +USING: alien.syntax ; IN: unix.statfs.linux C-STRUCT: statfs64 diff --git a/basis/unix/statvfs/linux/linux.factor b/basis/unix/statvfs/linux/linux.factor index 008692a501..3bfbffa197 100644 --- a/basis/unix/statvfs/linux/linux.factor +++ b/basis/unix/statvfs/linux/linux.factor @@ -14,7 +14,7 @@ C-STRUCT: statvfs64 { "__fsfilcnt64_t" "f_favail" } { "ulong" "f_fsid" } { "ulong" "f_flag" } - { "ulong" f_namemax" } + { "ulong" "f_namemax" } { { "int" 6 } "__f_spare" } ; FUNCTION: int statvfs64 ( char* path, statvfs64* buf ) ; From 4de326869fc9632756f4000e1f831e1455cb7c7d Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 1 Dec 2008 17:40:21 -0600 Subject: [PATCH 06/33] boids: Implement Slava's suggestion to have the system iteration happen outside of 'draw-gadget*' --- extra/boids/boids.factor | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor index b0d5bda508..8319a2d8d9 100644 --- a/extra/boids/boids.factor +++ b/extra/boids/boids.factor @@ -25,7 +25,7 @@ USING: kernel ui.render multi-methods multi-method-syntax - combinators.short-circuit.smart + combinators.short-circuit processing.shapes flatland ; @@ -86,7 +86,7 @@ TUPLE: < { radius initial: 25 } ; [ BEHAVIOUR view-angle>> in-view? ] [ eq? not ] } - && ; + 2&& ; :: neighborhood ( SELF OTHERS BEHAVIOUR -- boids ) OTHERS [| OTHER | SELF OTHER BEHAVIOUR within-neighborhood? ] filter ; @@ -154,7 +154,7 @@ M: ungraft* ( -- ) t >>paused drop ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -M:: draw-gadget* ( BOIDS-GADGET -- ) +:: iterate-system ( BOIDS-GADGET -- ) [let | SKY [ BOIDS-GADGET gadget->sky ] BOIDS [ BOIDS-GADGET boids>> ] @@ -183,11 +183,14 @@ M:: draw-gadget* ( BOIDS-GADGET -- ) map - BOIDS-GADGET (>>boids) + BOIDS-GADGET (>>boids) ] ; - origin get - [ BOIDS-GADGET boids>> [ draw-boid ] each ] - with-translation ] ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +M:: draw-gadget* ( BOIDS-GADGET -- ) + origin get + [ BOIDS-GADGET boids>> [ draw-boid ] each ] + with-translation ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -197,7 +200,7 @@ M:: draw-gadget* ( BOIDS-GADGET -- ) [ GADGET paused>> [ f ] - [ GADGET relayout-1 25 milliseconds sleep t ] + [ GADGET iterate-system GADGET relayout-1 1 milliseconds sleep t ] if ] loop From 32dbd07c7781eb824d29a24d7117bf43076df10f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 1 Dec 2008 17:51:21 -0600 Subject: [PATCH 07/33] remove empty vocab --- extra/line-art/authors.txt | 1 - extra/line-art/summary.txt | 1 - extra/line-art/tags.txt | 3 --- 3 files changed, 5 deletions(-) delete mode 100644 extra/line-art/authors.txt delete mode 100644 extra/line-art/summary.txt delete mode 100644 extra/line-art/tags.txt diff --git a/extra/line-art/authors.txt b/extra/line-art/authors.txt deleted file mode 100644 index 6a0dc7293a..0000000000 --- a/extra/line-art/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Joe Groff \ No newline at end of file diff --git a/extra/line-art/summary.txt b/extra/line-art/summary.txt deleted file mode 100644 index 06d16da2bf..0000000000 --- a/extra/line-art/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Stanford Bunny rendered with cartoon-style lines instead of shading \ No newline at end of file diff --git a/extra/line-art/tags.txt b/extra/line-art/tags.txt deleted file mode 100644 index 0db7e8e629..0000000000 --- a/extra/line-art/tags.txt +++ /dev/null @@ -1,3 +0,0 @@ -demos -opengl -glsl \ No newline at end of file From 77def0bc962bd65ffc3c5f68f61c2a45d081e351 Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Mon, 1 Dec 2008 17:53:17 -0600 Subject: [PATCH 08/33] was using each-line from io by accident, dont' even need io in USING: list here --- basis/ui/gadgets/editors/editors.factor | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) mode change 100644 => 100755 basis/ui/gadgets/editors/editors.factor diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor old mode 100644 new mode 100755 index ad81d18f92..e262ac7fea --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2006, 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays documents io kernel math models +USING: accessors arrays documents kernel math models namespaces locals fry make opengl opengl.gl sequences strings io.styles math.vectors sorting colors combinators assocs math.order fry calendar alarms ui.clipboards ui.commands @@ -218,7 +218,7 @@ M: editor ungraft* ] with-editor-translation ; : selection-start/end ( editor -- start end ) - dup editor-mark* swap editor-caret* sort-pair ; + [ editor-mark* ] [ editor-caret* ] bi sort-pair ; : (draw-selection) ( x1 x2 -- ) over - @@ -227,9 +227,8 @@ M: editor ungraft* swap [ gl-fill-rect ] with-translation ; : draw-selected-line ( start end n -- ) - [ start/end-on-line ] keep tuck - [ editor get offset>x ] 2dip - editor get offset>x + [ start/end-on-line ] keep + tuck [ editor get offset>x ] 2bi@ (draw-selection) ; : draw-selection ( -- ) @@ -237,9 +236,9 @@ M: editor ungraft* editor get selection-start/end over first [ 2dup [ - [ 2dup ] dip draw-selected-line + draw-selected-line 1 translate-lines - ] each-line 2drop + ] with with each-line ] with-editor-translation ; M: editor draw-gadget* From 8b106b6a774c62c2729079c7199f878c6adca36b Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Mon, 1 Dec 2008 17:54:35 -0600 Subject: [PATCH 09/33] Clean up a bit --- basis/ui/windows/windows.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor index cb63833edd..1d3212c436 100755 --- a/basis/ui/windows/windows.factor +++ b/basis/ui/windows/windows.factor @@ -284,7 +284,7 @@ SYMBOL: nc-buttons message>button nc-buttons get swap [ push ] [ delete ] if ; -: >lo-hi ( WORD -- array ) [ lo-word ] keep hi-word 2array ; +: >lo-hi ( WORD -- array ) [ lo-word ] [ hi-word ] bi 2array ; : mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ; : mouse-absolute>relative ( lparam handle -- array ) From d59f8b10dc6f5de4335f9ca2af325506ef929d77 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 1 Dec 2008 18:08:39 -0600 Subject: [PATCH 10/33] Fix printing of negative fixnums in FEP --- vm/os-unix.h | 1 + vm/os-windows.h | 8 ++++---- vm/utilities.c | 2 +- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/vm/os-unix.h b/vm/os-unix.h index 97b1b39129..b2a1735fd7 100755 --- a/vm/os-unix.h +++ b/vm/os-unix.h @@ -23,6 +23,7 @@ typedef char F_SYMBOL; #define STRNCMP strncmp #define STRDUP strdup +#define FIXNUM_FORMAT "%ld" #define CELL_FORMAT "%lu" #define CELL_HEX_FORMAT "%lx" diff --git a/vm/os-windows.h b/vm/os-windows.h index b12d677af2..af9b75bca5 100755 --- a/vm/os-windows.h +++ b/vm/os-windows.h @@ -20,13 +20,13 @@ typedef wchar_t F_CHAR; #define STRNCMP wcsncmp #define STRDUP _wcsdup +#define FIXNUM_FORMAT "%Id" +#define CELL_FORMAT "%lu" +#define CELL_HEX_FORMAT "%Ix" + #ifdef WIN64 - #define CELL_FORMAT "%Iu" - #define CELL_HEX_FORMAT "%Ix" #define CELL_HEX_PAD_FORMAT "%016Ix" #else - #define CELL_FORMAT "%lu" - #define CELL_HEX_FORMAT "%lx" #define CELL_HEX_PAD_FORMAT "%08lx" #endif diff --git a/vm/utilities.c b/vm/utilities.c index 35fc7ad087..d97b540884 100755 --- a/vm/utilities.c +++ b/vm/utilities.c @@ -44,7 +44,7 @@ void print_cell_hex_pad(CELL x) void print_fixnum(F_FIXNUM x) { - printf(CELL_FORMAT,x); + printf(FIXNUM_FORMAT,x); } CELL read_cell_hex(void) From 9e4dfda8cdfabaf8b655934528c45344d24dc989 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 1 Dec 2008 18:08:48 -0600 Subject: [PATCH 11/33] Fix help lint --- core/vocabs/loader/loader-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/vocabs/loader/loader-docs.factor b/core/vocabs/loader/loader-docs.factor index bc57c48a62..ce3b5ea024 100644 --- a/core/vocabs/loader/loader-docs.factor +++ b/core/vocabs/loader/loader-docs.factor @@ -66,7 +66,7 @@ HELP: vocab-roots { $var-description "A sequence of pathname strings to search for vocabularies." } ; HELP: add-vocab-root -{ $values { "path" "a pathname string" } } +{ $values { "root" "a pathname string" } } { $description "Adds a directory pathname to the list of vocabulary roots." } { $see-also "factor-roots" } ; From 6d8d4b309844a98caefa830303818d177605dc4c Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Mon, 1 Dec 2008 18:20:19 -0600 Subject: [PATCH 12/33] Fix odd Windows mouse wheel behavior --- basis/ui/windows/windows.factor | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor index 1d3212c436..1481287e95 100755 --- a/basis/ui/windows/windows.factor +++ b/basis/ui/windows/windows.factor @@ -285,12 +285,8 @@ SYMBOL: nc-buttons swap [ push ] [ delete ] if ; : >lo-hi ( WORD -- array ) [ lo-word ] [ hi-word ] bi 2array ; -: mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ; -: mouse-absolute>relative ( lparam handle -- array ) - [ >lo-hi ] dip - "RECT" [ GetWindowRect win32-error=0/f ] keep - get-RECT-top-left 2array v- ; +: mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ; : mouse-event>gesture ( uMsg -- button ) key-modifiers swap message>button @@ -340,9 +336,7 @@ SYMBOL: nc-buttons >lo-hi swap window move-hand fire-motion ; :: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- ) - wParam mouse-wheel - lParam hWnd mouse-absolute>relative - hWnd window send-wheel ; + wParam mouse-wheel hand-loc get hWnd window send-wheel ; : handle-wm-cancelmode ( hWnd uMsg wParam lParam -- ) #! message sent if windows needs application to stop dragging From ef0410ef504b4368416d54043a61e895a18b0322 Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Mon, 1 Dec 2008 18:20:32 -0600 Subject: [PATCH 13/33] Use bi instead of dup/swap in a couple of places --- basis/ui/x11/x11.factor | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) mode change 100644 => 100755 basis/ui/x11/x11.factor diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor old mode 100644 new mode 100755 index b5c71bc3fb..b65236d1f9 --- a/basis/ui/x11/x11.factor +++ b/basis/ui/x11/x11.factor @@ -117,7 +117,7 @@ M: world button-up-event } at ; M: world wheel-event - [ dup mouse-event>scroll-direction swap mouse-event-loc ] dip + [ [ mouse-event>scroll-direction ] [ mouse-event-loc ] bi ] dip send-wheel ; M: world enter-event motion-event ; @@ -125,7 +125,7 @@ M: world enter-event motion-event ; M: world leave-event 2drop forget-rollover ; M: world motion-event - [ dup XMotionEvent-x swap XMotionEvent-y 2array ] dip + [ [ XMotionEvent-x ] [ XMotionEvent-y ] bi 2array ] dip move-hand fire-motion ; M: world focus-in-event @@ -146,10 +146,10 @@ M: world selection-notify-event : clipboard-for-atom ( atom -- clipboard ) { - { [ dup XA_PRIMARY = ] [ drop selection get ] } - { [ dup XA_CLIPBOARD = ] [ drop clipboard get ] } + { XA_PRIMARY [ selection get ] } + { XA_CLIPBOARD [ clipboard get ] } [ drop ] - } cond ; + } case ; : encode-clipboard ( string type -- bytes ) XSelectionRequestEvent-target From f72c951a6bc73e1a819aa3c6d2bd8254df4bb103 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 1 Dec 2008 19:51:01 -0600 Subject: [PATCH 14/33] Kill environment init hook --- basis/tools/deploy/shaker/shaker.factor | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 00cee32ddb..53f147ccce 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -23,10 +23,8 @@ IN: tools.deploy.shaker : strip-init-hooks ( -- ) "Stripping startup hooks" show - "cpu.x86" init-hooks get delete-at - "command-line" init-hooks get delete-at - "libc" init-hooks get delete-at - "system" init-hooks get delete-at + { "cpu.x86" "command-line" "libc" "system" "environment" } + [ init-hooks get delete-at ] each deploy-threads? get [ "threads" init-hooks get delete-at ] unless From 439f91bb84dc18b8d64892d210bc93f2c8c53a74 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 1 Dec 2008 20:30:52 -0600 Subject: [PATCH 15/33] fix usings --- basis/io/unix/files/freebsd/freebsd.factor | 6 +++--- basis/io/unix/files/openbsd/openbsd.factor | 12 ++++++------ 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/basis/io/unix/files/freebsd/freebsd.factor b/basis/io/unix/files/freebsd/freebsd.factor index 48dfd37584..16ef9f61d2 100644 --- a/basis/io/unix/files/freebsd/freebsd.factor +++ b/basis/io/unix/files/freebsd/freebsd.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax kernel unix math accessors -combinators system io.backend alien.c-types unix.statfs -io.files ; +USING: accessors alien.c-types alien.syntax combinators +io.backend io.files io.unix.files kernel math system unix +unix.statfs unix.statvfs.freebsd ; IN: io.unix.files.freebsd M: freebsd file-system-statvfs ( path -- byte-array ) diff --git a/basis/io/unix/files/openbsd/openbsd.factor b/basis/io/unix/files/openbsd/openbsd.factor index d348d281fb..bea10de7bb 100644 --- a/basis/io/unix/files/openbsd/openbsd.factor +++ b/basis/io/unix/files/openbsd/openbsd.factor @@ -2,16 +2,19 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien.syntax accessors combinators kernel unix.types math system io.backend alien.c-types unix -unix.statfs io.files ; +unix.statfs io.files io.unix.files unix.statvfs.openbsd ; IN: io.unix.files.openbsd -M: openbsd >file-system-info ( file-system-info statvfs -- file-system-info' ) +M: openbsd file-system-statvfs ( normalized-path -- statvfs ) + "statvfs" tuck statvfs io-error ; + +M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info' ) { [ statvfs-f_bsize >>block-size ] [ statvfs-f_frsize >>preferred-block-size ] [ statvfs-f_blocks >>blocks ] [ statvfs-f_bfree >>blocks-free ] - [ statvfs-f_bavail >>blocks-avail ] + [ statvfs-f_bavail >>blocks-available ] [ statvfs-f_files >>files ] [ statvfs-f_ffree >>files-free ] [ statvfs-f_favail >>files-available ] @@ -19,6 +22,3 @@ M: openbsd >file-system-info ( file-system-info statvfs -- file-system-info' ) [ statvfs-f_flag >>flags ] [ statvfs-f_namemax >>name-max ] } cleave ; - -M: openbsd file-system-statvfs ( normalized-path -- statvfs ) - "statvfs" tuck statvfs io-error ; From 7553b816f8f00ba0600d2bcdf901c22660fb495c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 1 Dec 2008 21:20:33 -0600 Subject: [PATCH 16/33] add another slot to file-system-info -- available-space, which is what the user can actually use, not what's free on disk --- basis/io/windows/files/files.factor | 22 +++++++++++++--------- core/io/files/files.factor | 2 +- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor index 7f84b9d9e5..4c38ee3b12 100755 --- a/basis/io/windows/files/files.factor +++ b/basis/io/windows/files/files.factor @@ -257,9 +257,6 @@ M: winnt link-info ( path -- info ) HOOK: root-directory os ( string -- string' ) -TUPLE: winnt-file-system-info < file-system-info -total-bytes total-free-bytes ; - : file-system-type ( normalized-path -- str ) MAX_PATH 1+ MAX_PATH 1+ @@ -269,21 +266,28 @@ total-bytes total-free-bytes ; [ GetVolumeInformation win32-error=0/f ] 2keep drop utf16n alien>string ; -: file-system-space ( normalized-path -- free-space total-bytes total-free-bytes ) +: file-system-space ( normalized-path -- available-space total-space free-space ) "ULARGE_INTEGER" "ULARGE_INTEGER" "ULARGE_INTEGER" [ GetDiskFreeSpaceEx win32-error=0/f ] 3keep ; +: calculate-file-system-info ( file-system-info -- file-system-info' ) + { + [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ] + [ ] + } cleave ; + M: winnt file-system-info ( path -- file-system-info ) normalize-path root-directory dup [ file-system-type ] [ file-system-space ] bi - \ winnt-file-system-info new - swap *ulonglong >>total-free-bytes - swap *ulonglong >>total-bytes + \ file-system-info new swap *ulonglong >>free-space + swap *ulonglong >>total-space + swap *ulonglong >>available-space swap >>type - swap >>mount-point ; + swap >>mount-point + calculate-file-system-info ; : volume>paths ( string -- array ) 16384 "ushort" tuck dup length @@ -324,7 +328,7 @@ M: winnt file-systems ( -- array ) find-volumes [ volume>paths ] map concat [ [ file-system-info ] - [ drop winnt-file-system-info new swap >>mount-point ] recover + [ drop \ file-system-info new swap >>mount-point ] recover ] map ; : file-times ( path -- timestamp timestamp timestamp ) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index cd1c5d698c..77b37180c6 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -188,7 +188,7 @@ SYMBOL: +unknown+ HOOK: file-systems os ( -- array ) TUPLE: file-system-info device-name mount-point type -free-space used-space total-space ; +available-space free-space used-space total-space ; HOOK: file-system-info os ( path -- file-system-info ) From c178718bb33f8b3f2e857123504c23c54e8dcbb1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 1 Dec 2008 21:53:30 -0600 Subject: [PATCH 17/33] fix openbsd --- basis/io/unix/files/openbsd/openbsd.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/unix/files/openbsd/openbsd.factor b/basis/io/unix/files/openbsd/openbsd.factor index bea10de7bb..68f2e62f40 100644 --- a/basis/io/unix/files/openbsd/openbsd.factor +++ b/basis/io/unix/files/openbsd/openbsd.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien.syntax accessors combinators kernel unix.types math system io.backend alien.c-types unix -unix.statfs io.files io.unix.files unix.statvfs.openbsd ; +io.files io.unix.files unix.statvfs.openbsd ; IN: io.unix.files.openbsd M: openbsd file-system-statvfs ( normalized-path -- statvfs ) From 8e63b4bde54c5bea75f8dd00fab47e42b660e367 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 1 Dec 2008 22:31:09 -0600 Subject: [PATCH 18/33] irc.gitbot: simple IRC bot which tracks git commits, work in progress --- extra/irc/gitbot/gitbot.factor | 55 ++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) create mode 100644 extra/irc/gitbot/gitbot.factor diff --git a/extra/irc/gitbot/gitbot.factor b/extra/irc/gitbot/gitbot.factor new file mode 100644 index 0000000000..93ccb2b407 --- /dev/null +++ b/extra/irc/gitbot/gitbot.factor @@ -0,0 +1,55 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: fry irc.client irc.client.private kernel namespaces +sequences threads io.encodings.8-bit io.launcher io splitting +make mason.common mason.updates calendar math alarms ; +IN: irc.gitbot + +: bot-profile ( -- obj ) + "irc.freenode.org" 6667 "jackass" f ; + +: bot-channel ( -- seq ) "#concatenative" ; + +GENERIC: handle-message ( msg -- ) + +M: object handle-message drop ; + +: bot-loop ( chat -- ) + dup hear handle-message bot-loop ; + +: start-bot ( -- chat ) + bot-profile + [ connect-irc ] + [ + [ bot-channel dup ] dip + '[ _ [ _ attach-chat ] [ bot-loop ] bi ] + "GitBot" spawn drop + ] bi ; + +: git-log ( from to -- lines ) + [ + "git-log" , + "--no-merges" , + "--pretty=format:%h %an: %s" , + ".." swap 3append , + ] { } make + latin1 [ input-stream get lines ] with-process-reader ; + +: updates ( from to -- lines ) + git-log reverse + dup length 4 > [ 4 head "... and more" suffix ] when ; + +: report-updates ( from to chat -- ) + [ updates ] dip + [ 1 seconds sleep ] swap + '[ _ speak ] interleave ; + +: check-for-updates ( chat -- ) + [ git-id git-pull-cmd short-running-process git-id ] dip + report-updates ; + +: bot ( -- ) + start-bot + '[ _ check-for-updates ] 5 minutes every drop ; + +MAIN: bot From 2777f54e74fd3222f64acfdb96d414fbd3bc4d7a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 1 Dec 2008 22:31:15 -0600 Subject: [PATCH 19/33] XML parsing benchmark --- extra/benchmark/xml/xml.factor | 11 +++++++++++ 1 file changed, 11 insertions(+) create mode 100644 extra/benchmark/xml/xml.factor diff --git a/extra/benchmark/xml/xml.factor b/extra/benchmark/xml/xml.factor new file mode 100644 index 0000000000..a61293cd99 --- /dev/null +++ b/extra/benchmark/xml/xml.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: io.encodings.utf8 io.files kernel sequences xml ; +IN: benchmark.xml + +: xml-benchmark ( -- ) + "resource:basis/xmode/modes/" [ + [ utf8 read-xml drop ] each + ] with-directory-files ; + +MAIN: xml-benchmark From 082b788cdb4542f280488c25b7a1bbbb29325310 Mon Sep 17 00:00:00 2001 From: Daniel Lee Harple Date: Tue, 2 Dec 2008 01:15:34 -0500 Subject: [PATCH 20/33] Don't add f to vocab-roots --- basis/environment/environment.factor | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/basis/environment/environment.factor b/basis/environment/environment.factor index ca78c3efa7..d6ce34dbcf 100644 --- a/basis/environment/environment.factor +++ b/basis/environment/environment.factor @@ -27,6 +27,9 @@ HOOK: (set-os-envs) os ( seq -- ) } cond [ - "FACTOR_ROOTS" os-env os windows? ";" ":" ? split - [ add-vocab-root ] each + "FACTOR_ROOTS" os-env + [ + os windows? ";" ":" ? split + [ add-vocab-root ] each + ] when* ] "environment" add-init-hook From c27faa3de4e0b156d51a39140cc703c8c509225c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 2 Dec 2008 00:25:23 -0600 Subject: [PATCH 21/33] Remove 3compose: nothing in core used it, and basis code can use fry --- basis/fry/fry-docs.factor | 4 ++-- basis/xmode/utilities/utilities.factor | 26 +++++++++++++------------- core/io/io.factor | 2 +- core/kernel/kernel-docs.factor | 13 ------------- core/kernel/kernel.factor | 3 --- extra/combinators/lib/lib.factor | 2 +- extra/inverse/inverse.factor | 7 +++---- extra/sequences/lib/lib.factor | 6 +----- 8 files changed, 21 insertions(+), 42 deletions(-) diff --git a/basis/fry/fry-docs.factor b/basis/fry/fry-docs.factor index a982ecdd7d..1dff0942bd 100644 --- a/basis/fry/fry-docs.factor +++ b/basis/fry/fry-docs.factor @@ -46,10 +46,10 @@ $nl "{ 10 20 30 } [ sq ] [ . ] compose each" "{ 10 20 30 } [ sq . ] each" } -"The " { $link _ } " and " { $link @ } " specifiers may be freely mixed:" +"The " { $link _ } " and " { $link @ } " specifiers may be freely mixed, and the result is considerably more concise and readable than the version using " { $link curry } " and " { $link compose } " directly:" { $code "{ 8 13 14 27 } [ even? ] 5 '[ @ dup _ ? ] map" - "{ 8 13 14 27 } [ even? ] 5 [ dup ] swap [ ? ] curry 3compose map" + "{ 8 13 14 27 } [ even? ] 5 [ dup ] swap [ ? ] curry compose compose map" "{ 8 13 14 27 } [ even? dup 5 ? ] map" } "The following is a no-op:" diff --git a/basis/xmode/utilities/utilities.factor b/basis/xmode/utilities/utilities.factor index 8f1a6184e8..23e4195158 100644 --- a/basis/xmode/utilities/utilities.factor +++ b/basis/xmode/utilities/utilities.factor @@ -1,30 +1,30 @@ USING: accessors sequences assocs kernel quotations namespaces -xml.data xml.utilities combinators macros parser lexer words ; +xml.data xml.utilities combinators macros parser lexer words fry ; IN: xmode.utilities -: implies >r not r> or ; inline +: implies [ not ] dip or ; inline : child-tags ( tag -- seq ) children>> [ tag? ] filter ; : map-find ( seq quot -- result elt ) f -rot - [ nip ] swap [ dup ] 3compose find - >r [ drop f ] unless r> ; inline + '[ nip @ dup ] find + [ [ drop f ] unless ] dip ; inline : tag-init-form ( spec -- quot ) { { [ dup quotation? ] [ [ object get tag get ] prepose ] } { [ dup length 2 = ] [ - first2 [ - >r >r tag get children>string - r> [ execute ] when* object get r> execute - ] 2curry + first2 '[ + tag get children>string + _ [ execute ] when* object get _ execute + ] ] } { [ dup length 3 = ] [ - first3 [ - >r >r tag get at - r> [ execute ] when* object get r> execute - ] 3curry + first3 '[ + _ tag get at + _ [ execute ] when* object get _ execute + ] ] } } cond ; @@ -36,7 +36,7 @@ MACRO: (init-from-tag) ( specs -- ) [ with-tag-initializer ] curry ; : init-from-tag ( tag tuple specs -- tuple ) - over >r (init-from-tag) r> ; inline + over [ (init-from-tag) ] dip ; inline SYMBOL: tag-handlers SYMBOL: tag-handler-word diff --git a/core/io/io.factor b/core/io/io.factor index c1fd69a16a..fc553cc163 100644 --- a/core/io/io.factor +++ b/core/io/io.factor @@ -65,7 +65,7 @@ SYMBOL: error-stream : with-streams ( input output quot -- ) [ [ with-streams* ] 3curry ] - [ [ drop dispose dispose ] 3curry ] 3bi + [ drop [ [ dispose ] bi@ ] 2curry ] 3bi [ ] cleanup ; inline : tabular-output ( style quot -- ) diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index 3fc3d175a0..91b18d834b 100644 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -578,18 +578,6 @@ HELP: prepose { compose prepose } related-words -HELP: 3compose -{ $values { "quot1" callable } { "quot2" callable } { "quot3" callable } { "compose" compose } } -{ $description "Quotation composition. Outputs a " { $link callable } " which calls " { $snippet "quot1" } ", " { $snippet "quot2" } " and then " { $snippet "quot3" } "." } -{ $notes - "The following two lines are equivalent:" - { $code - "3compose call" - "3append call" - } - "However, " { $link 3compose } " runs in constant time, and the compiler is able to compile code which calls composed quotations." -} ; - HELP: dip { $values { "x" object } { "quot" quotation } } { $description "Calls " { $snippet "quot" } " with " { $snippet "obj" } " hidden on the retain stack." } @@ -814,7 +802,6 @@ ARTICLE: "compositional-combinators" "Compositional combinators" { $subsection 3curry } { $subsection with } { $subsection compose } -{ $subsection 3compose } { $subsection prepose } "Quotations also implement the sequence protocol, and can be manipulated with sequence words; see " { $link "quotations" } "." ; diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index 1677a2faaa..bbe2d348d8 100644 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -179,9 +179,6 @@ GENERIC: boa ( ... class -- tuple ) : prepose ( quot1 quot2 -- compose ) swap compose ; inline -: 3compose ( quot1 quot2 quot3 -- compose ) - compose compose ; inline - ! Booleans : not ( obj -- ? ) [ f ] [ t ] if ; inline diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index 9a668b8e6e..0ae86c48c4 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -142,7 +142,7 @@ MACRO: multikeep ( word out-indexes -- ... ) [ tuck 2slip ] dip while ; inline : generate ( generator predicate -- obj ) - [ dup ] swap [ dup [ nip ] unless not ] 3compose + '[ dup @ dup [ nip ] unless not ] swap [ ] do-while ; MACRO: predicates ( seq -- quot/f ) diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index dfef23b56a..8a2ce57e70 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -5,7 +5,7 @@ sequences assocs math arrays stack-checker effects generalizations continuations debugger classes.tuple namespaces make vectors bit-arrays byte-arrays strings sbufs math.functions macros sequences.private combinators mirrors -combinators.short-circuit ; +combinators.short-circuit fry ; IN: inverse TUPLE: fail ; @@ -46,7 +46,7 @@ M: no-inverse summary dup word? [ "Badly formed math inverse" throw ] when 1quotation ; : swap-inverse ( math-inverse revquot -- revquot* quot ) - next assure-constant rot second [ swap ] swap 3compose ; + next assure-constant rot second '[ @ swap @ ] ; : pull-inverse ( math-inverse revquot const -- revquot* quot ) assure-constant rot first compose ; @@ -236,8 +236,7 @@ DEFER: _ ] recover ; inline : true-out ( quot effect -- quot' ) - out>> [ ndrop ] curry - [ t ] 3compose ; + out>> '[ @ _ ndrop t ] ; : false-recover ( effect -- quot ) in>> [ ndrop f ] curry [ recover-fail ] curry ; diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index 9dc01c04fa..68bea839a9 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -90,12 +90,8 @@ ERROR: element-not-found ; dupd find over [ element-not-found ] unless >r cut rest r> swap ; inline -: (map-until) ( quot pred -- quot ) - [ dup ] swap 3compose - [ [ drop t ] [ , f ] if ] compose [ find 2drop ] curry ; - : map-until ( seq quot pred -- newseq ) - (map-until) { } make ; + '[ [ @ dup @ [ drop t ] [ , f ] if ] find 2drop ] { } make ; : take-while ( seq quot -- newseq ) [ not ] compose From 53d44bb78c3db1b5b7ab0192ecb944224cf60695 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 2 Dec 2008 00:52:48 -0600 Subject: [PATCH 22/33] remove unused vocab --- basis/unix/statfs/netbsd/authors.txt | 1 - basis/unix/statfs/netbsd/netbsd.factor | 6 ------ basis/unix/statfs/netbsd/tags.txt | 1 - basis/unix/statfs/statfs.factor | 4 ++-- 4 files changed, 2 insertions(+), 10 deletions(-) delete mode 100644 basis/unix/statfs/netbsd/authors.txt delete mode 100644 basis/unix/statfs/netbsd/netbsd.factor delete mode 100644 basis/unix/statfs/netbsd/tags.txt diff --git a/basis/unix/statfs/netbsd/authors.txt b/basis/unix/statfs/netbsd/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/basis/unix/statfs/netbsd/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/netbsd/netbsd.factor b/basis/unix/statfs/netbsd/netbsd.factor deleted file mode 100644 index 5617ca7533..0000000000 --- a/basis/unix/statfs/netbsd/netbsd.factor +++ /dev/null @@ -1,6 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax kernel unix.stat math unix -combinators system io.backend accessors alien.c-types -io.encodings.utf8 alien.strings unix.types unix.statfs io.files ; -IN: unix.statfs.netbsd diff --git a/basis/unix/statfs/netbsd/tags.txt b/basis/unix/statfs/netbsd/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/unix/statfs/netbsd/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/unix/statfs/statfs.factor b/basis/unix/statfs/statfs.factor index bc7b199705..4e3ba0d9f9 100644 --- a/basis/unix/statfs/statfs.factor +++ b/basis/unix/statfs/statfs.factor @@ -8,6 +8,6 @@ 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 ] } + ! { netbsd [ "unix.statfs.netbsd" require ] } + ! { openbsd [ "unix.statfs.openbsd" require ] } } case From 3a8f784baadfb56f563ddefec32b663b65be0bac Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 2 Dec 2008 00:53:30 -0600 Subject: [PATCH 23/33] add a tags file --- basis/unix/statvfs/freebsd/tags.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 basis/unix/statvfs/freebsd/tags.txt diff --git a/basis/unix/statvfs/freebsd/tags.txt b/basis/unix/statvfs/freebsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/statvfs/freebsd/tags.txt @@ -0,0 +1 @@ +unportable From 90a50c73edbba17df9add74402c8e208a3996575 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 2 Dec 2008 02:45:53 -0600 Subject: [PATCH 24/33] Forgot to add fry to USING: list in sequences.lib --- extra/sequences/lib/lib.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index 68bea839a9..0674b8d9d2 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -5,7 +5,7 @@ USING: combinators.lib kernel sequences math namespaces make assocs random sequences.private shuffle math.functions arrays math.parser math.private sorting strings ascii macros assocs.lib quotations hashtables math.order locals generalizations -math.ranges random ; +math.ranges random fry ; IN: sequences.lib : each-withn ( seq quot n -- ) nwith each ; inline From e4db2afb7e8f7c2e8ed12c21858ddd40eb62391d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 2 Dec 2008 03:10:01 -0600 Subject: [PATCH 25/33] Update cpu.x86.assembler to use dip instead of >r/r> --- basis/cpu/x86/assembler/assembler.factor | 12 ++++++------ basis/cpu/x86/assembler/syntax/syntax.factor | 4 ++-- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor index 05fe3a8093..27c00cb3c0 100644 --- a/basis/cpu/x86/assembler/assembler.factor +++ b/basis/cpu/x86/assembler/assembler.factor @@ -130,7 +130,7 @@ M: register modifier drop BIN: 11 ; GENERIC# n, 1 ( value n -- ) M: integer n, >le % ; -M: byte n, >r value>> r> n, ; +M: byte n, [ value>> ] dip n, ; : 1, ( n -- ) 1 n, ; inline : 4, ( n -- ) 4 n, ; inline : 2, ( n -- ) 2 n, ; inline @@ -209,7 +209,7 @@ M: object operand-64? drop f ; : short-operand ( reg rex.w n -- ) #! Some instructions encode their single operand as part of #! the opcode. - >r dupd prefix-1 reg-code r> + , ; + [ dupd prefix-1 reg-code ] dip + , ; : opcode, ( opcode -- ) dup array? [ % ] [ , ] if ; @@ -224,7 +224,7 @@ M: object operand-64? drop f ; : 1-operand ( op reg,rex.w,opcode -- ) #! The 'reg' is not really a register, but a value for the #! 'reg' field of the mod-r/m byte. - first3 >r >r over r> prefix-1 r> opcode, swap addressing ; + first3 [ [ over ] dip prefix-1 ] dip opcode, swap addressing ; : immediate-operand-size-bit ( imm dst reg,rex.w,opcode -- imm dst reg,rex.w,opcode ) pick integer? [ first3 BIN: 1 opcode-or 3array ] when ; @@ -250,7 +250,7 @@ M: object operand-64? drop f ; ] if ; : (2-operand) ( dst src op -- ) - >r 2dup t rex-prefix r> opcode, + [ 2dup t rex-prefix ] dip opcode, reg-code swap addressing ; : direction-bit ( dst src op -- dst' src' op' ) @@ -271,11 +271,11 @@ M: object operand-64? drop f ; PRIVATE> : [] ( reg/displacement -- indirect ) - dup integer? [ >r f f f r> ] [ f f f ] if ; + dup integer? [ [ f f f ] dip ] [ f f f ] if ; : [+] ( reg displacement -- indirect ) dup integer? - [ dup zero? [ drop f ] when >r f f r> ] + [ dup zero? [ drop f ] when [ f f ] dip ] [ f f ] if ; diff --git a/basis/cpu/x86/assembler/syntax/syntax.factor b/basis/cpu/x86/assembler/syntax/syntax.factor index d267baaf4f..6ddec4af07 100644 --- a/basis/cpu/x86/assembler/syntax/syntax.factor +++ b/basis/cpu/x86/assembler/syntax/syntax.factor @@ -4,8 +4,8 @@ USING: kernel words sequences lexer parser fry ; IN: cpu.x86.assembler.syntax : define-register ( name num size -- ) - >r >r "cpu.x86.assembler" create dup define-symbol r> r> - >r dupd "register" set-word-prop r> + [ "cpu.x86.assembler" create dup define-symbol ] 2dip + [ dupd "register" set-word-prop ] dip "register-size" set-word-prop ; : define-registers ( names size -- ) From 74a112f1cf50fa876a6ee3061e4e87b04ddda417 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 2 Dec 2008 03:10:13 -0600 Subject: [PATCH 26/33] Update cpu.x86.basis/io to use dip instead of >r/r> --- basis/io/buffers/buffers-tests.factor | 2 +- basis/io/encodings/utf16/utf16.factor | 2 +- basis/io/monitors/monitors.factor | 2 +- basis/io/monitors/recursive/recursive.factor | 18 +++++++++--------- basis/io/pools/pools.factor | 2 +- basis/io/streams/duplex/duplex.factor | 2 +- basis/io/timeouts/timeouts.factor | 8 ++++---- basis/io/unix/backend/backend.factor | 13 +++++-------- basis/io/unix/linux/monitors/monitors.factor | 8 +++----- basis/io/unix/macosx/monitors/monitors.factor | 6 ++---- basis/io/unix/select/select.factor | 4 ++-- basis/io/unix/sockets/sockets.factor | 10 +++++----- basis/io/unix/unix-tests.factor | 8 ++++---- basis/io/windows/files/files.factor | 14 +++++++------- basis/io/windows/nt/backend/backend.factor | 16 ++++++---------- basis/io/windows/nt/files/files.factor | 2 +- basis/io/windows/nt/launcher/launcher.factor | 4 ++-- .../io/windows/nt/privileges/privileges.factor | 8 ++++---- basis/io/windows/nt/sockets/sockets.factor | 8 ++++---- basis/io/windows/sockets/sockets.factor | 8 ++++---- basis/io/windows/windows.factor | 3 ++- 21 files changed, 69 insertions(+), 79 deletions(-) diff --git a/basis/io/buffers/buffers-tests.factor b/basis/io/buffers/buffers-tests.factor index b3c5c4ee90..4425e08106 100644 --- a/basis/io/buffers/buffers-tests.factor +++ b/basis/io/buffers/buffers-tests.factor @@ -5,7 +5,7 @@ destructors ; : buffer-set ( string buffer -- ) over >byte-array over ptr>> byte-array>memory - >r length r> buffer-reset ; + [ length ] dip buffer-reset ; : string>buffer ( string -- buffer ) dup length tuck buffer-set ; diff --git a/basis/io/encodings/utf16/utf16.factor b/basis/io/encodings/utf16/utf16.factor index 037087e452..167d7534d1 100644 --- a/basis/io/encodings/utf16/utf16.factor +++ b/basis/io/encodings/utf16/utf16.factor @@ -25,7 +25,7 @@ ERROR: missing-bom ; : quad-be ( stream byte -- stream char ) double-be over stream-read1 [ dup -2 shift BIN: 110111 number= [ - >r 2 shift r> BIN: 11 bitand bitor + [ 2 shift ] dip BIN: 11 bitand bitor over stream-read1 swap append-nums HEX: 10000 + ] [ 2drop dup stream-read1 drop replacement-char ] if ] when* ; diff --git a/basis/io/monitors/monitors.factor b/basis/io/monitors/monitors.factor index 7f33f0caa6..72f2bc80c5 100644 --- a/basis/io/monitors/monitors.factor +++ b/basis/io/monitors/monitors.factor @@ -53,7 +53,7 @@ SYMBOL: +rename-file-new+ SYMBOL: +rename-file+ : with-monitor ( path recursive? quot -- ) - >r r> with-disposal ; inline + [ ] dip with-disposal ; inline { { [ os macosx? ] [ "io.unix.macosx.monitors" require ] } diff --git a/basis/io/monitors/recursive/recursive.factor b/basis/io/monitors/recursive/recursive.factor index 45979363c9..a96c6f04f1 100644 --- a/basis/io/monitors/recursive/recursive.factor +++ b/basis/io/monitors/recursive/recursive.factor @@ -3,7 +3,7 @@ USING: accessors sequences assocs arrays continuations destructors combinators kernel threads concurrency.messaging concurrency.mailboxes concurrency.promises io.files io.monitors -debugger ; +debugger fry ; IN: io.monitors.recursive ! Simulate recursive monitors on platforms that don't have them @@ -29,10 +29,10 @@ DEFER: add-child-monitor qualify-path dup link-info directory? [ [ add-child-monitors ] [ - [ - [ f my-mailbox (monitor) ] keep + '[ + _ [ f my-mailbox (monitor) ] keep monitor tget children>> set-at - ] curry ignore-errors + ] ignore-errors ] bi ] [ drop ] if ; @@ -48,7 +48,7 @@ M: recursive-monitor dispose* monitor tget children>> [ nip dispose ] assoc-each ; : pump-step ( msg -- ) - first3 path>> swap >r prepend-path r> monitor tget 3array + first3 path>> swap [ prepend-path ] dip monitor tget 3array monitor tget queue>> mailbox-put ; @@ -71,9 +71,9 @@ M: recursive-monitor dispose* : pump-loop ( -- ) receive dup synchronous? [ - >r stop-pump t r> reply-synchronous + [ stop-pump t ] dip reply-synchronous ] [ - [ [ update-hierarchy ] curry ignore-errors ] [ pump-step ] bi + [ '[ _ update-hierarchy ] ignore-errors ] [ pump-step ] bi pump-loop ] if ; @@ -88,7 +88,7 @@ M: recursive-monitor dispose* pump-loop ; : start-pump-thread ( monitor -- ) - dup [ pump-thread ] curry + dup '[ _ pump-thread ] "Recursive monitor pump" spawn >>thread drop ; @@ -96,7 +96,7 @@ M: recursive-monitor dispose* ready>> ?promise ?linked drop ; : ( path mailbox -- monitor ) - >r (normalize-path) r> + [ (normalize-path) ] dip recursive-monitor new-monitor H{ } clone >>children >>ready diff --git a/basis/io/pools/pools.factor b/basis/io/pools/pools.factor index aa734e6809..2c1f8ea3c3 100644 --- a/basis/io/pools/pools.factor +++ b/basis/io/pools/pools.factor @@ -42,7 +42,7 @@ GENERIC: make-connection ( pool -- conn ) [ nip call ] [ drop return-connection ] 3bi ; inline : with-pooled-connection ( pool quot -- ) - >r [ acquire-connection ] keep r> + [ [ acquire-connection ] keep ] dip [ (with-pooled-connection) ] [ ] [ 2drop dispose ] cleanup ; inline M: return-connection dispose diff --git a/basis/io/streams/duplex/duplex.factor b/basis/io/streams/duplex/duplex.factor index 2ba504c653..9bf637432f 100644 --- a/basis/io/streams/duplex/duplex.factor +++ b/basis/io/streams/duplex/duplex.factor @@ -27,7 +27,7 @@ M: duplex-stream dispose ] with-destructors ; : ( stream-in stream-out encoding -- duplex ) - tuck re-encode >r re-decode r> ; + tuck [ re-decode ] [ re-encode ] 2bi* ; : with-stream* ( stream quot -- ) [ [ in>> ] [ out>> ] bi ] dip with-streams* ; inline diff --git a/basis/io/timeouts/timeouts.factor b/basis/io/timeouts/timeouts.factor index 029cf6cac0..fd1b14de19 100644 --- a/basis/io/timeouts/timeouts.factor +++ b/basis/io/timeouts/timeouts.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov, Doug Coleman ! See http://factorcode.org/license.txt for BSD license. USING: kernel calendar alarms io io.encodings accessors -namespaces ; +namespaces fry ; IN: io.timeouts GENERIC: timeout ( obj -- dt/f ) @@ -14,14 +14,14 @@ M: encoder set-timeout stream>> set-timeout ; GENERIC: cancel-operation ( obj -- ) : queue-timeout ( obj timeout -- alarm ) - >r [ cancel-operation ] curry r> later ; + [ '[ _ cancel-operation ] ] dip later ; : with-timeout* ( obj timeout quot -- ) - 3dup drop queue-timeout >r nip call r> cancel-alarm ; + 3dup drop queue-timeout [ nip call ] dip cancel-alarm ; inline : with-timeout ( obj quot -- ) - over timeout [ >r dup timeout r> with-timeout* ] [ call ] if ; + over timeout [ [ dup timeout ] dip with-timeout* ] [ call ] if ; inline : timeouts ( dt -- ) diff --git a/basis/io/unix/backend/backend.factor b/basis/io/unix/backend/backend.factor index 5bb0b82555..85363c8404 100644 --- a/basis/io/unix/backend/backend.factor +++ b/basis/io/unix/backend/backend.factor @@ -5,7 +5,7 @@ math io.ports sequences strings sbufs threads unix vectors io.buffers io.backend io.encodings math.parser continuations system libc qualified namespaces make io.timeouts io.encodings.utf8 destructors accessors summary combinators -locals unix.time ; +locals unix.time fry ; QUALIFIED: io IN: io.unix.backend @@ -88,19 +88,16 @@ M: io-timeout summary drop "I/O operation timed out" ; : wait-for-fd ( handle event -- ) dup +retry+ eq? [ 2drop ] [ - [ - >r - swap handle-fd - mx get-global - r> { + '[ + swap handle-fd mx get-global _ { { +input+ [ add-input-callback ] } { +output+ [ add-output-callback ] } } case - ] curry "I/O" suspend nip [ io-timeout ] when + ] "I/O" suspend nip [ io-timeout ] when ] if ; : wait-for-port ( port event -- ) - [ >r handle>> r> wait-for-fd ] curry with-timeout ; + '[ handle>> _ wait-for-fd ] with-timeout ; ! Some general stuff : file-mode OCT: 0666 ; diff --git a/basis/io/unix/linux/monitors/monitors.factor b/basis/io/unix/linux/monitors/monitors.factor index 12b1cf779b..f27d48c6b0 100644 --- a/basis/io/unix/linux/monitors/monitors.factor +++ b/basis/io/unix/linux/monitors/monitors.factor @@ -36,9 +36,7 @@ TUPLE: linux-monitor < monitor wd inotify watches disposed ; inotify-fd -rot inotify_add_watch dup io-error dup check-existing ; : add-watch ( path mask mailbox -- monitor ) - >r - >r (normalize-path) r> - [ (add-watch) ] [ drop ] 2bi r> + [ [ (normalize-path) ] dip [ (add-watch) ] [ drop ] 2bi ] dip [ ] [ ] [ wd>> ] tri watches get set-at ; : check-inotify ( -- ) @@ -103,12 +101,12 @@ M: linux-monitor dispose* ( monitor -- ) : next-event ( i buffer -- i buffer ) 2dup inotify-event@ inotify-event-len "inotify-event" heap-size + - swap >r + r> ; + swap [ + ] dip ; : parse-file-notifications ( i buffer -- ) 2dup events-exhausted? [ 2drop ] [ 2dup inotify-event@ dup inotify-event-wd wd>monitor - >r parse-file-notify r> queue-change + [ parse-file-notify ] dip queue-change next-event parse-file-notifications ] if ; diff --git a/basis/io/unix/macosx/monitors/monitors.factor b/basis/io/unix/macosx/monitors/monitors.factor index a5f36aa93b..cde1d6339a 100644 --- a/basis/io/unix/macosx/monitors/monitors.factor +++ b/basis/io/unix/macosx/monitors/monitors.factor @@ -2,15 +2,13 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io.backend io.monitors core-foundation.fsevents continuations kernel sequences -namespaces arrays system locals accessors destructors ; +namespaces arrays system locals accessors destructors fry ; IN: io.unix.macosx.monitors TUPLE: macosx-monitor < monitor handle ; : enqueue-notifications ( triples monitor -- ) - [ - >r first { +modify-file+ } r> queue-change - ] curry each ; + '[ first { +modify-file+ } _ queue-change ] each ; M:: macosx (monitor) ( path recursive? mailbox -- monitor ) [let | path [ path normalize-path ] | diff --git a/basis/io/unix/select/select.factor b/basis/io/unix/select/select.factor index 1dd1d51e87..27231aee5a 100644 --- a/basis/io/unix/select/select.factor +++ b/basis/io/unix/select/select.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types kernel io.ports io.unix.backend bit-arrays sequences assocs unix math namespaces -accessors math.order locals unix.time ; +accessors math.order locals unix.time fry ; IN: io.unix.select TUPLE: select-mx < mx read-fdset write-fdset ; @@ -28,7 +28,7 @@ TUPLE: select-mx < mx read-fdset write-fdset ; [ check-fd ] 3curry each ; inline : init-fdset ( fds fdset -- ) - [ >r t swap munge r> set-nth ] curry each ; + '[ t swap munge _ set-nth ] each ; : read-fdset/tasks ( mx -- seq fdset ) [ reads>> keys ] [ read-fdset>> ] bi ; diff --git a/basis/io/unix/sockets/sockets.factor b/basis/io/unix/sockets/sockets.factor index a98432b84d..5fba7badb0 100644 --- a/basis/io/unix/sockets/sockets.factor +++ b/basis/io/unix/sockets/sockets.factor @@ -16,18 +16,18 @@ IN: io.unix.sockets 0 socket dup io-error init-fd |dispose ; : set-socket-option ( fd level opt -- ) - >r >r handle-fd r> r> 1 "int" heap-size setsockopt io-error ; + [ handle-fd ] 2dip 1 "int" heap-size setsockopt io-error ; M: unix addrinfo-error ( n -- ) dup zero? [ drop ] [ gai_strerror throw ] if ; ! Client sockets - TCP and Unix domain M: object (get-local-address) ( handle remote -- sockaddr ) - >r handle-fd r> empty-sockaddr/size + [ handle-fd ] dip empty-sockaddr/size [ getsockname io-error ] 2keep drop ; M: object (get-remote-address) ( handle local -- sockaddr ) - >r handle-fd r> empty-sockaddr/size + [ handle-fd ] dip empty-sockaddr/size [ getpeername io-error ] 2keep drop ; : init-client-socket ( fd -- ) @@ -60,7 +60,7 @@ M: object ((client)) ( addrspec -- fd ) SOL_SOCKET SO_REUSEADDR set-socket-option ; : server-socket-fd ( addrspec type -- fd ) - >r dup protocol-family r> socket-fd + [ dup protocol-family ] dip socket-fd dup init-server-socket dup handle-fd rot make-sockaddr/size bind io-error ; @@ -77,7 +77,7 @@ M: object (server) ( addrspec -- handle ) M: object (accept) ( server addrspec -- fd sockaddr ) 2dup do-accept { - { [ over 0 >= ] [ >r 2nip init-fd r> ] } + { [ over 0 >= ] [ [ 2nip init-fd ] dip ] } { [ err_no EINTR = ] [ 2drop (accept) ] } { [ err_no EAGAIN = ] [ 2drop diff --git a/basis/io/unix/unix-tests.factor b/basis/io/unix/unix-tests.factor index 7e1dc48e5f..df61420c77 100644 --- a/basis/io/unix/unix-tests.factor +++ b/basis/io/unix/unix-tests.factor @@ -46,7 +46,7 @@ yield "Receive 1" print - "d" get receive >r reverse r> + "d" get receive [ reverse ] dip "Send 1" print dup . @@ -55,7 +55,7 @@ yield "Receive 2" print - "d" get receive >r " world" append r> + "d" get receive [ " world" append ] dip "Send 1" print dup . @@ -86,7 +86,7 @@ datagram-client [ "olleh" t ] [ "d" get receive datagram-server = - >r >string r> + [ >string ] dip ] unit-test [ ] [ @@ -98,7 +98,7 @@ datagram-client [ "hello world" t ] [ "d" get receive datagram-server = - >r >string r> + [ >string ] dip ] unit-test [ ] [ "d" get dispose ] unit-test diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor index 4c38ee3b12..83954e045b 100755 --- a/basis/io/windows/files/files.factor +++ b/basis/io/windows/files/files.factor @@ -10,7 +10,7 @@ IN: io.windows.files : open-file ( path access-mode create-mode flags -- handle ) [ - >r >r share-mode default-security-attributes r> r> + [ share-mode default-security-attributes ] 2dip CreateFile-flags f CreateFile opened-file ] with-destructors ; @@ -46,7 +46,7 @@ IN: io.windows.files GetLastError ERROR_ALREADY_EXISTS = not ; : set-file-pointer ( handle length method -- ) - >r dupd d>w/w r> SetFilePointer + [ dupd d>w/w ] dip SetFilePointer INVALID_SET_FILE_POINTER = [ CloseHandle "SetFilePointer failed" throw ] when drop ; @@ -348,23 +348,23 @@ M: winnt file-systems ( -- array ) : set-file-times ( path timestamp/f timestamp/f timestamp/f -- ) #! timestamp order: creation access write [ - >r >r >r + [ normalize-path open-existing &dispose handle>> - r> r> r> (set-file-times) + ] 3dip (set-file-times) ] with-destructors ; : set-file-create-time ( path timestamp -- ) f f set-file-times ; : set-file-access-time ( path timestamp -- ) - >r f r> f set-file-times ; + [ f ] dip f set-file-times ; : set-file-write-time ( path timestamp -- ) - >r f f r> set-file-times ; + [ f f ] dip set-file-times ; M: winnt touch-file ( path -- ) [ normalize-path - maybe-create-file >r &dispose r> + maybe-create-file [ &dispose ] dip [ drop ] [ handle>> f now dup (set-file-times) ] if ] with-destructors ; diff --git a/basis/io/windows/nt/backend/backend.factor b/basis/io/windows/nt/backend/backend.factor index 4e335da749..8035bd66e9 100644 --- a/basis/io/windows/nt/backend/backend.factor +++ b/basis/io/windows/nt/backend/backend.factor @@ -18,8 +18,8 @@ C: io-callback "OVERLAPPED" malloc-object &free ; : make-overlapped ( port -- overlapped-ext ) - >r (make-overlapped) - r> handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ; + [ (make-overlapped) ] dip + handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ; : ( handle existing -- handle ) f 1 CreateIoCompletionPort dup win32-error=0/f ; @@ -64,13 +64,9 @@ M: winnt add-completion ( win32-handle -- ) : handle-overlapped ( us -- ? ) wait-for-overlapped [ dup [ - >r drop GetLastError 1array r> resume-callback t - ] [ - 2drop f - ] if - ] [ - resume-callback t - ] if ; + [ drop GetLastError 1array ] dip resume-callback t + ] [ 2drop f ] if + ] [ resume-callback t ] if ; M: win32-handle cancel-operation [ check-disposed ] [ handle>> CancelIo drop ] bi ; @@ -94,7 +90,7 @@ M: winnt init-io ( -- ) : wait-for-file ( FileArgs n port -- n ) swap file-error? - [ 2drop 0 ] [ >r lpOverlapped>> r> twiddle-thumbs ] if ; + [ 2drop 0 ] [ [ lpOverlapped>> ] dip twiddle-thumbs ] if ; : update-file-ptr ( n port -- ) handle>> dup ptr>> [ rot + >>ptr drop ] [ 2drop ] if* ; diff --git a/basis/io/windows/nt/files/files.factor b/basis/io/windows/nt/files/files.factor index 2fbc809263..9f25eb5eb1 100644 --- a/basis/io/windows/nt/files/files.factor +++ b/basis/io/windows/nt/files/files.factor @@ -59,6 +59,6 @@ M: winnt FileArgs-overlapped ( port -- overlapped ) M: winnt open-append [ dup file-info size>> ] [ drop 0 ] recover - >r (open-append) r> >>ptr ; + [ (open-append) ] dip >>ptr ; M: winnt home "USERPROFILE" os-env ; diff --git a/basis/io/windows/nt/launcher/launcher.factor b/basis/io/windows/nt/launcher/launcher.factor index 9d02fbe2fd..de4fb99c64 100644 --- a/basis/io/windows/nt/launcher/launcher.factor +++ b/basis/io/windows/nt/launcher/launcher.factor @@ -52,7 +52,7 @@ IN: io.windows.nt.launcher CreateFile dup invalid-handle? &dispose handle>> ; : redirect-append ( path access-mode create-mode -- handle ) - >r >r path>> r> r> + [ path>> ] 2dip drop OPEN_ALWAYS redirect-file dup 0 FILE_END set-file-pointer ; @@ -61,7 +61,7 @@ IN: io.windows.nt.launcher 2drop handle>> duplicate-handle ; : redirect-stream ( stream access-mode create-mode -- handle ) - >r >r underlying-handle handle>> r> r> redirect-handle ; + [ underlying-handle handle>> ] 2dip redirect-handle ; : redirect ( obj access-mode create-mode -- handle ) { diff --git a/basis/io/windows/nt/privileges/privileges.factor b/basis/io/windows/nt/privileges/privileges.factor index 8418d09a5e..106cf06b77 100644 --- a/basis/io/windows/nt/privileges/privileges.factor +++ b/basis/io/windows/nt/privileges/privileges.factor @@ -20,12 +20,12 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES : with-process-token ( quot -- ) #! quot: ( token-handle -- token-handle ) - >r open-process-token r> + [ open-process-token ] dip [ keep ] curry [ CloseHandle drop ] [ ] cleanup ; inline : lookup-privilege ( string -- luid ) - >r f r> "LUID" + [ f ] dip "LUID" [ LookupPrivilegeValue win32-error=0/f ] keep ; : make-token-privileges ( name ? -- obj ) @@ -39,10 +39,10 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES set-LUID_AND_ATTRIBUTES-Attributes ] when - >r lookup-privilege r> + [ lookup-privilege ] dip [ TOKEN_PRIVILEGES-Privileges - >r 0 r> LUID_AND_ATTRIBUTES-nth + [ 0 ] dip LUID_AND_ATTRIBUTES-nth set-LUID_AND_ATTRIBUTES-Luid ] keep ; diff --git a/basis/io/windows/nt/sockets/sockets.factor b/basis/io/windows/nt/sockets/sockets.factor index 5d94cf2d4a..ecd9ea9d9b 100644 --- a/basis/io/windows/nt/sockets/sockets.factor +++ b/basis/io/windows/nt/sockets/sockets.factor @@ -176,8 +176,8 @@ TUPLE: WSASendTo-args port : make-send-buffer ( packet -- WSABUF ) "WSABUF" malloc-object &free - [ >r malloc-byte-array &free r> set-WSABUF-buf ] - [ >r length r> set-WSABUF-len ] + [ [ malloc-byte-array &free ] dip set-WSABUF-buf ] + [ [ length ] dip set-WSABUF-len ] [ nip ] 2tri ; inline @@ -186,8 +186,8 @@ TUPLE: WSASendTo-args port swap >>port dup port>> handle>> handle>> >>s swap make-sockaddr/size - >r malloc-byte-array &free - r> [ >>lpTo ] [ >>iToLen ] bi* + [ malloc-byte-array &free ] dip + [ >>lpTo ] [ >>iToLen ] bi* swap make-send-buffer >>lpBuffers 1 >>dwBufferCount 0 >>dwFlags diff --git a/basis/io/windows/sockets/sockets.factor b/basis/io/windows/sockets/sockets.factor index d9ab10d5e3..809af605e0 100644 --- a/basis/io/windows/sockets/sockets.factor +++ b/basis/io/windows/sockets/sockets.factor @@ -20,21 +20,21 @@ M: win32-socket dispose ( stream -- ) |dispose dup add-completion ; : open-socket ( addrspec type -- win32-socket ) - >r protocol-family r> + [ protocol-family ] dip 0 f 0 WSASocket-flags WSASocket dup socket-error opened-socket ; M: object (get-local-address) ( socket addrspec -- sockaddr ) - >r handle>> r> empty-sockaddr/size + [ handle>> ] dip empty-sockaddr/size [ getsockname socket-error ] 2keep drop ; M: object (get-remote-address) ( socket addrspec -- sockaddr ) - >r handle>> r> empty-sockaddr/size + [ handle>> ] dip empty-sockaddr/size [ getpeername socket-error ] 2keep drop ; : bind-socket ( win32-socket sockaddr len -- ) - >r >r handle>> r> r> bind socket-error ; + [ handle>> ] 2dip bind socket-error ; M: object ((client)) ( addrspec -- handle ) [ SOCK_STREAM open-socket ] keep diff --git a/basis/io/windows/windows.factor b/basis/io/windows/windows.factor index ce75293b38..94304edc05 100755 --- a/basis/io/windows/windows.factor +++ b/basis/io/windows/windows.factor @@ -8,7 +8,8 @@ splitting continuations math.bitwise system accessors ; IN: io.windows : set-inherit ( handle ? -- ) - >r HANDLE_FLAG_INHERIT r> >BOOLEAN SetHandleInformation win32-error=0/f ; + [ HANDLE_FLAG_INHERIT ] dip + >BOOLEAN SetHandleInformation win32-error=0/f ; TUPLE: win32-handle handle disposed ; From 8acd9c6814184dd11460e4536b2cb0c1e65e7d3f Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 2 Dec 2008 14:25:34 -0600 Subject: [PATCH 27/33] models.range: Correct stack effect for '' --- basis/models/range/range.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/models/range/range.factor b/basis/models/range/range.factor index 8e230a2d0c..53d99ab162 100644 --- a/basis/models/range/range.factor +++ b/basis/models/range/range.factor @@ -6,7 +6,7 @@ IN: models.range TUPLE: range < compose ; -: ( value min max page -- range ) +: ( value page min max -- range ) 4array [ ] map range new-compose ; : range-model ( range -- model ) dependencies>> first ; From 5c446e3460a4aa6781ba225cd369e5d294324ed1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 2 Dec 2008 14:44:00 -0600 Subject: [PATCH 28/33] fix bootstrap on netbsd --- basis/unix/statfs/statfs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/unix/statfs/statfs.factor b/basis/unix/statfs/statfs.factor index 4e3ba0d9f9..9a636b795f 100644 --- a/basis/unix/statfs/statfs.factor +++ b/basis/unix/statfs/statfs.factor @@ -8,6 +8,6 @@ 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 ] } + { netbsd [ ] } + { openbsd [ ] } } case From e609448b44d7803e8b243837f8b10e56e1d7ae7d Mon Sep 17 00:00:00 2001 From: Daniel Lee Harple Date: Tue, 2 Dec 2008 16:23:54 -0500 Subject: [PATCH 29/33] Fix scaffold to work with vocab-roots outside of Factor source tree. Cleanup check-vocab-root. --- basis/tools/scaffold/scaffold.factor | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 2811801266..d8822f51dc 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -17,23 +17,17 @@ ERROR: no-vocab vocab ; Date: Tue, 2 Dec 2008 16:27:54 -0600 Subject: [PATCH 30/33] Update qualified docs a little --- basis/qualified/qualified-docs.factor | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/basis/qualified/qualified-docs.factor b/basis/qualified/qualified-docs.factor index 067d221d2f..828d811b46 100644 --- a/basis/qualified/qualified-docs.factor +++ b/basis/qualified/qualified-docs.factor @@ -4,14 +4,21 @@ IN: qualified HELP: QUALIFIED: { $syntax "QUALIFIED: vocab" } { $description "Similar to " { $link POSTPONE: USE: } " but loads vocabulary with prefix." } -{ $examples { $code - "QUALIFIED: math\n1 2 math:+ ! ==> 3" } } ; +{ $examples { $example + "USING: prettyprint qualified ;" + "QUALIFIED: math" + "1 2 math:+ ." "3" +} } ; HELP: QUALIFIED-WITH: { $syntax "QUALIFIED-WITH: vocab word-prefix" } { $description "Works like " { $link POSTPONE: QUALIFIED: } " but uses " { $snippet "word-prefix" } " as prefix." } { $examples { $code - "QUALIFIED-WITH: math m\n1 2 m:+ ! ==> 3" } } ; + "USING: prettyprint qualified ;" + "QUALIFIED-WITH: math m" + "1 2 m:+ ." + "3" +} } ; HELP: FROM: { $syntax "FROM: vocab => words ... ;" } @@ -28,9 +35,12 @@ HELP: EXCLUDE: HELP: RENAME: { $syntax "RENAME: word vocab => newname " } { $description "Imports " { $snippet "word" } " from " { $snippet "vocab" } ", but renamed to " { $snippet "newname" } "." } -{ $examples { $code +{ $examples { $example + "USING: prettyprint qualified ;" "RENAME: + math => -" - "2 3 - ! => 5" } } ; + "2 3 - ." + "5" +} } ; ARTICLE: "qualified" "Qualified word lookup" "The " { $vocab-link "qualified" } " vocabulary provides a handful of parsing words which give more control over word lookup than is offered by " { $link POSTPONE: USE: } " and " { $link POSTPONE: USING: } "." From f2f1961eeba5e48802e0e3c495030bb59ee09b98 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 2 Dec 2008 16:28:11 -0600 Subject: [PATCH 31/33] Fix name clash in inverse: fry:_ -vs- inverse:_ --- extra/inverse/inverse.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index 8a2ce57e70..61c5da6bca 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -5,7 +5,8 @@ sequences assocs math arrays stack-checker effects generalizations continuations debugger classes.tuple namespaces make vectors bit-arrays byte-arrays strings sbufs math.functions macros sequences.private combinators mirrors -combinators.short-circuit fry ; +combinators.short-circuit fry qualified ; +RENAME: _ fry => __ IN: inverse TUPLE: fail ; @@ -236,7 +237,7 @@ DEFER: _ ] recover ; inline : true-out ( quot effect -- quot' ) - out>> '[ @ _ ndrop t ] ; + out>> '[ @ __ ndrop t ] ; : false-recover ( effect -- quot ) in>> [ ndrop f ] curry [ recover-fail ] curry ; From 46b33116306fda1482dcc55b8aea5b5e4d388bbb Mon Sep 17 00:00:00 2001 From: sheeple Date: Tue, 2 Dec 2008 17:17:24 -0600 Subject: [PATCH 32/33] Set libblas library name on FreeBSD. --- extra/math/blas/cblas/cblas.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/extra/math/blas/cblas/cblas.factor b/extra/math/blas/cblas/cblas.factor index 131007b9d0..58f179af80 100644 --- a/extra/math/blas/cblas/cblas.factor +++ b/extra/math/blas/cblas/cblas.factor @@ -5,6 +5,7 @@ IN: math.blas.cblas { [ os macosx? ] [ "libblas.dylib" "cdecl" add-library ] } { [ os windows? ] [ "blas.dll" "cdecl" add-library ] } { [ os openbsd? ] [ "libcblas.so" "cdecl" add-library ] } + { [ os freebsd? ] [ "libcblas.so" "cdecl" add-library ] } [ "libblas.so" "cdecl" add-library ] } cond >> From 9ac3f13b2ac0bb72ae5a903093ddb7ebfbfe04dd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 2 Dec 2008 17:43:07 -0600 Subject: [PATCH 33/33] Call statfs on OpenBSD. Clean up unused code --- basis/io/unix/files/openbsd/openbsd.factor | 37 ++++++++++++++++------ basis/unix/statfs/freebsd/freebsd.factor | 22 +------------ basis/unix/statfs/openbsd/openbsd.factor | 33 +++++++++++++++++++ basis/unix/statfs/openbsd/tags.txt | 1 + basis/unix/statfs/statfs.factor | 2 +- 5 files changed, 63 insertions(+), 32 deletions(-) create mode 100644 basis/unix/statfs/openbsd/openbsd.factor create mode 100644 basis/unix/statfs/openbsd/tags.txt diff --git a/basis/io/unix/files/openbsd/openbsd.factor b/basis/io/unix/files/openbsd/openbsd.factor index 68f2e62f40..463cbde675 100644 --- a/basis/io/unix/files/openbsd/openbsd.factor +++ b/basis/io/unix/files/openbsd/openbsd.factor @@ -5,20 +5,37 @@ unix.types math system io.backend alien.c-types unix io.files io.unix.files unix.statvfs.openbsd ; IN: io.unix.files.openbsd +M: openbsd file-system-statfs + "statfs" tuck statfs io-error ; + +M: openbsd statfs>file-system-info ( file-system-info statfs -- file-system-info' ) + { + [ statfs-f_flag >>flags ] + [ statfs-f_bsize >>block-size ] + [ statfs-f_iosize >>io-size ] + [ statfs-f_blocks >>blocks ] + [ statfs-f_bfree >>blocks-free ] + [ statfs-f_bavail >>blocks-available ] + [ statfs-f_files >>files ] + [ statfs-f_ffree >>files-free ] + [ statfs-f_favail >>files-available ] + [ statfs-f_syncwrites >>sync-writes ] + [ statfs-f_syncreads >>sync-reads ] + [ statfs-f_asyncwrites >>async-writes ] + [ statfs-f_asyncreads >>async-reads ] + [ statfs-f_fsid >>id ] + [ statfs-f_namemax >>name-max ] + [ statfs-f_owner >>owner ] + [ statfs-f_spare >>spare ] + [ statfs-f_fstypename alien>native-string >>type ] + [ statfs-f_mntonname alien>native-string >>mount-point ] + [ statfs-f_mntfromname alien>native-string >>device-name ] + } cleave ; + M: openbsd file-system-statvfs ( normalized-path -- statvfs ) "statvfs" tuck statvfs io-error ; M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info' ) { - [ statvfs-f_bsize >>block-size ] [ statvfs-f_frsize >>preferred-block-size ] - [ statvfs-f_blocks >>blocks ] - [ statvfs-f_bfree >>blocks-free ] - [ statvfs-f_bavail >>blocks-available ] - [ statvfs-f_files >>files ] - [ statvfs-f_ffree >>files-free ] - [ statvfs-f_favail >>files-available ] - [ statvfs-f_fsid >>id ] - [ statvfs-f_flag >>flags ] - [ statvfs-f_namemax >>name-max ] } cleave ; diff --git a/basis/unix/statfs/freebsd/freebsd.factor b/basis/unix/statfs/freebsd/freebsd.factor index 5496bbe1ba..f6fcff5c7c 100644 --- a/basis/unix/statfs/freebsd/freebsd.factor +++ b/basis/unix/statfs/freebsd/freebsd.factor @@ -1,24 +1,4 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax kernel unix math accessors -combinators system io.backend alien.c-types unix.statfs -io.files ; +USING: alien.syntax ; IN: unix.statfs.freebsd - -: ST_RDONLY 1 ; inline -: ST_NOSUID 2 ; inline - -C-STRUCT: statvfs - { "fsblkcnt_t" "f_bavail" } - { "fsblkcnt_t" "f_bfree" } - { "fsblkcnt_t" "f_blocks" } - { "fsfilcnt_t" "f_favail" } - { "fsfilcnt_t" "f_ffree" } - { "fsfilcnt_t" "f_files" } - { "ulong" "f_bsize" } - { "ulong" "f_flag" } - { "ulong" "f_frsize" } - { "ulong" "f_fsid" } - { "ulong" "f_namemax" } ; - -FUNCTION: int statvfs ( char* path, statvfs* buf ) ; diff --git a/basis/unix/statfs/openbsd/openbsd.factor b/basis/unix/statfs/openbsd/openbsd.factor new file mode 100644 index 0000000000..98bf140af7 --- /dev/null +++ b/basis/unix/statfs/openbsd/openbsd.factor @@ -0,0 +1,33 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax ; +IN: unix.statfs.openbsd + +: MFSNAMELEN 16 ; inline +: MNAMELEN 90 ; inline + +C-STRUCT: statfs + { "u_int32_t" "f_flags" } + { "u_int32_t" "f_bsize" } + { "u_int32_t" "f_iosize" } + { "u_int64_t" "f_blocks" } + { "u_int64_t" "f_bfree" } + { "int64_t" "f_bavail" } + { "u_int64_t" "f_files" } + { "u_int64_t" "f_ffree" } + { "int64_t" "f_favail" } + { "u_int64_t" "f_syncwrites" } + { "u_int64_t" "f_syncreads" } + { "u_int64_t" "f_asyncwrites" } + { "u_int64_t" "f_asyncreads" } + { "fsid_t" "f_fsid" } + { "u_int32_t" "f_namemax" } + { "uid_t" "f_owner" } + { "u_int32_t" "f_ctime" } + { { "u_int32_t" 3 } "f_spare" } + { { "char" MFSNAMELEN } "f_fstypename" } + { { "char" MNAMELEN } "f_mntonname" } + { { "char" MNAMELEN } "f_mntfromname" } ; + ! { "mount_info" "mount_info" } ; + +FUNCTION: int statfs ( char* path, statvfs* buf ) ; diff --git a/basis/unix/statfs/openbsd/tags.txt b/basis/unix/statfs/openbsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/statfs/openbsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/unix/statfs/statfs.factor b/basis/unix/statfs/statfs.factor index 9a636b795f..7d1bebc72d 100644 --- a/basis/unix/statfs/statfs.factor +++ b/basis/unix/statfs/statfs.factor @@ -8,6 +8,6 @@ os { { linux [ "unix.statfs.linux" require ] } { macosx [ "unix.statfs.macosx" require ] } { freebsd [ "unix.statfs.freebsd" require ] } + { openbsd [ "unix.statfs.openbsd" require ] } { netbsd [ ] } - { openbsd [ ] } } case