Merge branch 'master' into new_codegen
commit
0c89575632
|
@ -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 ] }
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
USING: layouts combinators vocabs.loader ;
|
||||
USING: layouts combinators vocabs.loader alien.syntax ;
|
||||
IN: unix.stat
|
||||
|
||||
cell-bits {
|
||||
|
|
|
@ -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 ] }
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -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
|
|
@ -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" <c-object> tuck statvfs io-error
|
||||
statvfs>file-system-info ;
|
|
@ -0,0 +1 @@
|
|||
unportable
|
|
@ -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 ] }
|
||||
|
|
|
@ -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
|
||||
<tuple-layout> ;
|
||||
|
||||
|
@ -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 ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue