]> gitweb.factorcode.org Git - factor.git/blob - basis/io/unix/files/freebsd/freebsd.factor
Merge branch 'master' into experimental (untested!)
[factor.git] / basis / io / unix / files / freebsd / freebsd.factor
1 ! Copyright (C) 2008 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types alien.syntax combinators
4 io.backend io.files io.unix.files kernel math system unix
5 unix.statfs.freebsd unix.statvfs.freebsd unix.getfsstat.freebsd
6 sequences grouping alien.strings io.encodings.utf8
7 specialized-arrays.direct.uint arrays ;
8 IN: io.unix.files.freebsd
9
10 TUPLE: freebsd-file-system-info < unix-file-system-info
11 version io-size owner syncreads syncwrites asyncreads asyncwrites ;
12
13 M: freebsd new-file-system-info freebsd-file-system-info new ;
14
15 M: freebsd file-system-statfs ( path -- byte-array )
16     "statfs" <c-object> tuck statfs io-error ;
17
18 M: freebsd statfs>file-system-info ( file-system-info statvfs -- file-system-info )
19     {
20         [ statfs-f_version >>version ]
21         [ statfs-f_type >>type ]
22         [ statfs-f_flags >>flags ]
23         [ statfs-f_bsize >>block-size ]
24         [ statfs-f_iosize >>io-size ]
25         [ statfs-f_blocks >>blocks ]
26         [ statfs-f_bfree >>blocks-free ]
27         [ statfs-f_bavail >>blocks-available ]
28         [ statfs-f_files >>files ]
29         [ statfs-f_ffree >>files-free ]
30         [ statfs-f_syncwrites >>syncwrites ]
31         [ statfs-f_asyncwrites >>asyncwrites ]
32         [ statfs-f_syncreads >>syncreads ]
33         [ statfs-f_asyncreads >>asyncreads ]
34         [ statfs-f_namemax >>name-max ]
35         [ statfs-f_owner >>owner ]
36         [ statfs-f_fsid 2 <direct-uint-array> >array >>id ]
37         [ statfs-f_fstypename utf8 alien>string >>type ]
38         [ statfs-f_mntfromname utf8 alien>string >>device-name ]
39         [ statfs-f_mntonname utf8 alien>string >>mount-point ]
40     } cleave ;
41
42 M: freebsd file-system-statvfs ( path -- byte-array )
43     "statvfs" <c-object> tuck statvfs io-error ;
44
45 M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info )
46     {
47         [ statvfs-f_favail >>files-available ]
48         [ statvfs-f_frsize >>preferred-block-size ]
49     } cleave ;
50
51 M: freebsd file-systems ( -- array )
52     f 0 0 getfsstat dup io-error
53     "statfs" <c-array> dup dup length 0 getfsstat io-error
54     "statfs" heap-size group
55     [ statfs-f_mntonname alien>native-string file-system-info ] map ;