diff --git a/basis/unix/stat/linux/linux.factor b/basis/unix/stat/linux/linux.factor index 4bcab0b477..f1c931617e 100644 --- a/basis/unix/stat/linux/linux.factor +++ b/basis/unix/stat/linux/linux.factor @@ -1,12 +1,6 @@ USING: alien.syntax layouts combinators vocabs.loader ; IN: unix.stat -C-STRUCT: fsid - { { "int" 2 } "__val" } ; - -TYPEDEF: fsid __fsid_t -TYPEDEF: fsid fsid_t - cell-bits { { 32 [ "unix.stat.linux.32" require ] } diff --git a/basis/unix/stat/netbsd/netbsd.factor b/basis/unix/stat/netbsd/netbsd.factor index 8057e5939b..6fccd570e3 100644 --- a/basis/unix/stat/netbsd/netbsd.factor +++ b/basis/unix/stat/netbsd/netbsd.factor @@ -1,4 +1,4 @@ -USING: layouts combinators vocabs.loader ; +USING: layouts combinators vocabs.loader alien.syntax ; IN: unix.stat cell-bits { diff --git a/basis/unix/stat/stat.factor b/basis/unix/stat/stat.factor index f8ad74c213..17d6604fc0 100644 --- a/basis/unix/stat/stat.factor +++ b/basis/unix/stat/stat.factor @@ -18,6 +18,12 @@ FUNCTION: int chmod ( char* path, mode_t mode ) ; FUNCTION: int fchmod ( int fd, mode_t mode ) ; FUNCTION: int mkdir ( char* path, mode_t mode ) ; +C-STRUCT: fsid + { { "int" 2 } "__val" } ; + + TYPEDEF: fsid __fsid_t + TYPEDEF: fsid fsid_t + << os { { linux [ "unix.stat.linux" require ] } { macosx [ "unix.stat.macosx" require ] } diff --git a/basis/unix/statfs/netbsd/authors.txt b/basis/unix/statfs/netbsd/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/unix/statfs/netbsd/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/netbsd/netbsd-tests.factor b/basis/unix/statfs/netbsd/netbsd-tests.factor new file mode 100644 index 0000000000..be100c1cb6 --- /dev/null +++ b/basis/unix/statfs/netbsd/netbsd-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test unix.statfs.netbsd ; +IN: unix.statfs.netbsd.tests diff --git a/basis/unix/statfs/netbsd/netbsd.factor b/basis/unix/statfs/netbsd/netbsd.factor new file mode 100644 index 0000000000..c58d6e1a0d --- /dev/null +++ b/basis/unix/statfs/netbsd/netbsd.factor @@ -0,0 +1,76 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax kernel io.files unix.stat math unix +combinators system io.backend accessors alien.c-types +io.encodings.utf8 alien.strings ; +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_NAMELEN } "f_mntonname" } + { { "char" _VFS_NAMELEN } "f_mntfromname" } ; + +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 ; + +: statvfs>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-on ] + [ statvfs-f_mntfromname utf8 alien>string >>mount-from ] + } cleave ; + +M: netbsd file-system-info + normalize-path "statvfs" tuck statvfs io-error + statvfs>file-system-info ; diff --git a/basis/unix/statfs/netbsd/tags.txt b/basis/unix/statfs/netbsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/statfs/netbsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/unix/types/netbsd/netbsd.factor b/basis/unix/types/netbsd/netbsd.factor index 3982d1e9f9..d69d498704 100644 --- a/basis/unix/types/netbsd/netbsd.factor +++ b/basis/unix/types/netbsd/netbsd.factor @@ -8,6 +8,7 @@ TYPEDEF: __uint32_t dev_t TYPEDEF: __uint32_t mode_t TYPEDEF: __uint32_t nlink_t TYPEDEF: __uint32_t uid_t +TYPEDEF: __uint32_t __uid_t TYPEDEF: __uint32_t gid_t TYPEDEF: __int64_t off_t TYPEDEF: __int64_t blkcnt_t @@ -16,6 +17,12 @@ TYPEDEF: long ssize_t TYPEDEF: int pid_t TYPEDEF: int time_t +TYPEDEF: __uint64_t fsblkcnt_t +TYPEDEF: fsblkcnt_t __fsblkcnt_t + +TYPEDEF: __uint64_t fsfilcnt_t +TYPEDEF: fsfilcnt_t __fsfilcnt_t + cell-bits { { 32 [ "unix.types.netbsd.32" require ] } { 64 [ "unix.types.netbsd.64" require ] } diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 577ad133e1..8cde049524 100644 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -102,8 +102,8 @@ ERROR: bad-superclass class ; dup dup tuple-layout echelon>> [ tuple-instance? ] 2curry define-predicate ; -: superclass-size ( class -- n ) - superclasses but-last [ "slots" word-prop length ] sigma ; +: class-size ( class -- n ) + superclasses [ "slots" word-prop length ] sigma ; : (instance-check-quot) ( class -- quot ) [ @@ -138,16 +138,12 @@ ERROR: bad-superclass class ; : define-tuple-prototype ( class -- ) dup tuple-prototype "prototype" set-word-prop ; -: finalize-tuple-slots ( class slots -- slots ) - swap superclass-size 2 + finalize-slots ; - : define-tuple-slots ( class -- ) - dup dup "slots" word-prop finalize-tuple-slots - define-accessors ; + dup "slots" word-prop define-accessors ; : make-tuple-layout ( class -- layout ) [ ] - [ [ superclass-size ] [ "slots" word-prop length ] bi + ] + [ [ superclass class-size ] [ "slots" word-prop length ] bi + ] [ superclasses dup length 1- ] tri ; @@ -208,7 +204,6 @@ M: tuple-class update-class } cleave ; : define-new-tuple-class ( class superclass slots -- ) - make-slots [ drop f f tuple-class define-class ] [ nip "slots" set-word-prop ] [ 2drop update-classes ] @@ -241,16 +236,19 @@ M: tuple-class update-class : check-superclass ( superclass -- ) dup valid-superclass? [ bad-superclass ] unless drop ; +GENERIC# (define-tuple-class) 2 ( class superclass slots -- ) + PRIVATE> -GENERIC# define-tuple-class 2 ( class superclass slots -- ) - -M: word define-tuple-class +: define-tuple-class ( class superclass slots -- ) over check-superclass + make-slots over class-size 2 + finalize-slots + (define-tuple-class) ; + +M: word (define-tuple-class) define-new-tuple-class ; -M: tuple-class define-tuple-class - over check-superclass +M: tuple-class (define-tuple-class) 3dup tuple-class-unchanged? [ 3drop ] [ redefine-tuple-class ] if ;