steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' into new_codegen

db4
Slava Pestov 2008-10-20 05:56:44 -05:00
parent 461a4ddd0a 636873a41c
commit 0c89575632
9 changed files with 108 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/unix/stat/linux/linux.factor
View File

@ -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 ] }

2
basis/unix/stat/netbsd/netbsd.factor
View File

@ -1,4 +1,4 @@
USING: layouts combinators vocabs.loader ;
USING: layouts combinators vocabs.loader alien.syntax ;
IN: unix.stat
cell-bits {

6
basis/unix/stat/stat.factor
View File

@ -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 ] }

1
basis/unix/statfs/netbsd/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

4
basis/unix/statfs/netbsd/netbsd-tests.factor Normal file
View File

@ -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

76
basis/unix/statfs/netbsd/netbsd.factor Normal file
View File

@ -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 ;

1
basis/unix/statfs/netbsd/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

7
basis/unix/types/netbsd/netbsd.factor
View File

@ -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 ] }

26
core/classes/tuple/tuple.factor
View File

@ -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 ;