make a word generic

Doug Coleman 2008-10-21 01:27:15 -05:00
parent b9d23a2ce7
commit dfef28e715
6 changed files with 13 additions and 10 deletions

View File

@ -26,7 +26,7 @@ TUPLE: freebsd-file-system-info < file-system-info
bavail bfree blocks favail ffree ffiles bavail bfree blocks favail ffree ffiles
bsize flag frsize fsid namemax ; bsize flag frsize fsid namemax ;
: statfs>file-system-info ( struct -- statfs ) M: freebsd >file-system-info ( struct -- statfs )
[ \ freebsd-file-system-info new ] dip [ \ freebsd-file-system-info new ] dip
{ {
[ [
@ -49,4 +49,4 @@ bsize flag frsize fsid namemax ;
M: freebsd file-system-info ( path -- byte-array ) M: freebsd file-system-info ( path -- byte-array )
normalize-path normalize-path
"statvfs" <c-object> tuck statvfs io-error "statvfs" <c-object> tuck statvfs io-error
statfs>file-system-info ; >file-system-info ;

View File

@ -13,7 +13,7 @@ TUPLE: linux-file-system-info < file-system-info
type bsize blocks bfree bavail files ffree fsid type bsize blocks bfree bavail files ffree fsid
namelen frsize spare ; namelen frsize spare ;
: statfs>file-system-info ( struct -- statfs ) M: linux >file-system-info ( struct -- statfs )
[ \ linux-file-system-info new ] dip [ \ linux-file-system-info new ] dip
{ {
[ [
@ -36,4 +36,4 @@ namelen frsize spare ;
M: linux file-system-info ( path -- byte-array ) M: linux file-system-info ( path -- byte-array )
normalize-path normalize-path
"statfs64" <c-object> tuck statfs64 io-error "statfs64" <c-object> tuck statfs64 io-error
statfs>file-system-info ; >file-system-info ;

View File

@ -128,7 +128,7 @@ M: macosx mounted* ( -- array )
[ *void* ] dip [ *void* ] dip
"statfs64" heap-size [ * memory>byte-array ] keep group ; "statfs64" heap-size [ * memory>byte-array ] keep group ;
: statfs64>file-system-info ( byte-array -- file-system-info ) M: macosx >file-system-info ( byte-array -- file-system-info )
[ \ macosx-file-system-info new ] dip [ \ macosx-file-system-info new ] dip
{ {
[ [
@ -162,4 +162,4 @@ M: macosx mounted* ( -- array )
M: macosx file-system-info ( path -- file-system-info ) M: macosx file-system-info ( path -- file-system-info )
normalize-path normalize-path
"statfs64" <c-object> tuck statfs64 io-error "statfs64" <c-object> tuck statfs64 io-error
statfs64>file-system-info ; >file-system-info ;

View File

@ -43,7 +43,7 @@ files ffree sync-reads sync-writes async-reads async-writes
fsidx fsid namemax owner spare fstype mnotonname mntfromname fsidx fsid namemax owner spare fstype mnotonname mntfromname
file-system-type-name mount-from ; file-system-type-name mount-from ;
: statvfs>file-system-info ( byte-array -- netbsd-file-system-info ) M: netbsd >file-system-info ( byte-array -- netbsd-file-system-info )
[ \ netbsd-file-system-info new ] dip [ \ netbsd-file-system-info new ] dip
{ {
[ [
@ -75,4 +75,4 @@ file-system-type-name mount-from ;
M: netbsd file-system-info M: netbsd file-system-info
normalize-path "statvfs" <c-object> tuck statvfs io-error normalize-path "statvfs" <c-object> tuck statvfs io-error
statvfs>file-system-info ; >file-system-info ;

View File

@ -26,7 +26,7 @@ TUPLE: openbsd-file-system-info < file-system-info
bsize frsize blocks bfree bavail files ffree favail bsize frsize blocks bfree bavail files ffree favail
fsid flag namemax ; fsid flag namemax ;
: statfs>file-system-info ( struct -- statfs ) M: openbsd >file-system-info ( struct -- statfs )
[ \ openbsd-file-system-info new ] dip [ \ openbsd-file-system-info new ] dip
{ {
[ [
@ -49,4 +49,4 @@ fsid flag namemax ;
M: openbsd file-system-info ( path -- byte-array ) M: openbsd file-system-info ( path -- byte-array )
normalize-path normalize-path
"statvfs" <c-object> tuck statvfs io-error "statvfs" <c-object> tuck statvfs io-error
statfs>file-system-info ; >file-system-info ;

View File

@ -188,6 +188,9 @@ TUPLE: file-system-info mount-on free-space ;
HOOK: file-system-info os ( path -- file-system-info ) HOOK: file-system-info os ( path -- file-system-info )
HOOK: >file-system-info os ( struct -- statfs )
<PRIVATE <PRIVATE
HOOK: cd io-backend ( path -- ) HOOK: cd io-backend ( path -- )