diff --git a/basis/calendar/unix/unix.factor b/basis/calendar/unix/unix.factor index d5b66ffc1a..9848d0c164 100644 --- a/basis/calendar/unix/unix.factor +++ b/basis/calendar/unix/unix.factor @@ -4,13 +4,19 @@ USING: alien alien.c-types alien.syntax arrays calendar kernel math unix unix.time namespaces system ; IN: calendar.unix -: timeval>unix-time ( timeval -- timestamp ) +: timeval>seconds ( timeval -- seconds ) [ timeval-sec seconds ] [ timeval-usec microseconds ] bi - time+ since-1970 ; + time+ ; -: timespec>unix-time ( timeval -- timestamp ) +: timeval>unix-time ( timeval -- timestamp ) + timeval>seconds since-1970 ; + +: timespec>seconds ( timespec -- seconds ) [ timespec-sec seconds ] [ timespec-nsec nanoseconds ] bi - time+ since-1970 ; + time+ ; + +: timespec>unix-time ( timespec -- timestamp ) + timespec>seconds since-1970 ; : get-time ( -- alien ) f time localtime ; diff --git a/basis/cpu/x86/assembler/assembler-tests.factor b/basis/cpu/x86/assembler/assembler-tests.factor index 941bbe5b73..915847a453 100644 --- a/basis/cpu/x86/assembler/assembler-tests.factor +++ b/basis/cpu/x86/assembler/assembler-tests.factor @@ -4,9 +4,9 @@ IN: cpu.x86.assembler.tests [ { HEX: 49 HEX: 89 HEX: 04 HEX: 24 } ] [ [ R12 [] RAX MOV ] { } make ] unit-test [ { HEX: 49 HEX: 8b HEX: 06 } ] [ [ RAX R14 [] MOV ] { } make ] unit-test -! [ { HEX: 89 HEX: ca } ] [ [ EDX ECX MOV ] { } make ] unit-test -! [ { HEX: 4c HEX: 89 HEX: e2 } ] [ [ RDX R12 MOV ] { } make ] unit-test -! [ { HEX: 49 HEX: 89 HEX: d4 } ] [ [ R12 RDX MOV ] { } make ] unit-test +[ { HEX: 89 HEX: ca } ] [ [ EDX ECX MOV ] { } make ] unit-test +[ { HEX: 4c HEX: 89 HEX: e2 } ] [ [ RDX R12 MOV ] { } make ] unit-test +[ { HEX: 49 HEX: 89 HEX: d4 } ] [ [ R12 RDX MOV ] { } make ] unit-test [ { HEX: f2 HEX: 0f HEX: 2c HEX: c0 } ] [ [ EAX XMM0 CVTTSD2SI ] { } make ] unit-test [ { HEX: f2 HEX: 48 HEX: 0f HEX: 2c HEX: c0 } ] [ [ RAX XMM0 CVTTSD2SI ] { } make ] unit-test @@ -39,3 +39,21 @@ IN: cpu.x86.assembler.tests [ { HEX: 80 HEX: 08 HEX: 05 } ] [ [ EAX [] 5 OR ] { } make ] unit-test [ { HEX: c6 HEX: 00 HEX: 05 } ] [ [ EAX [] 5 MOV ] { } make ] unit-test + +[ { HEX: 49 HEX: 89 HEX: 04 HEX: 1a } ] [ [ R10 RBX [+] RAX MOV ] { } make ] unit-test +[ { HEX: 49 HEX: 89 HEX: 04 HEX: 1b } ] [ [ R11 RBX [+] RAX MOV ] { } make ] unit-test + +[ { HEX: 49 HEX: 89 HEX: 04 HEX: 1c } ] [ [ R12 RBX [+] RAX MOV ] { } make ] unit-test +[ { HEX: 48 HEX: 89 HEX: 04 HEX: 1c } ] [ [ RSP RBX [+] RAX MOV ] { } make ] unit-test + +[ { HEX: 49 HEX: 89 HEX: 44 HEX: 1d HEX: 00 } ] [ [ R13 RBX [+] RAX MOV ] { } make ] unit-test +[ { HEX: 48 HEX: 89 HEX: 44 HEX: 1d HEX: 00 } ] [ [ RBP RBX [+] RAX MOV ] { } make ] unit-test + +[ { HEX: 4a HEX: 89 HEX: 04 HEX: 23 } ] [ [ RBX R12 [+] RAX MOV ] { } make ] unit-test +[ { HEX: 4a HEX: 89 HEX: 04 HEX: 2b } ] [ [ RBX R13 [+] RAX MOV ] { } make ] unit-test + +[ { HEX: 4b HEX: 89 HEX: 44 HEX: 25 HEX: 00 } ] [ [ R13 R12 [+] RAX MOV ] { } make ] unit-test +[ { HEX: 4b HEX: 89 HEX: 04 HEX: 2c } ] [ [ R12 R13 [+] RAX MOV ] { } make ] unit-test + +[ { HEX: 49 HEX: 89 HEX: 04 HEX: 2c } ] [ [ R12 RBP [+] RAX MOV ] { } make ] unit-test +[ [ R12 RSP [+] RAX MOV ] { } make ] must-fail diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor index 91e4e8ca69..51b899fe31 100644 --- a/basis/cpu/x86/assembler/assembler.factor +++ b/basis/cpu/x86/assembler/assembler.factor @@ -64,18 +64,18 @@ M: indirect extended? base>> extended? ; : canonicalize-EBP ( indirect -- indirect ) #! { EBP } ==> { EBP 0 } - dup base>> { EBP RBP R13 } member? [ - dup displacement>> [ 0 >>displacement ] unless - ] when ; + dup [ base>> { EBP RBP R13 } member? ] [ displacement>> not ] bi and + [ 0 >>displacement ] when ; -: canonicalize-ESP ( indirect -- indirect ) - #! { ESP } ==> { ESP ESP } - dup base>> { ESP RSP R12 } member? [ ESP >>index ] when ; +ERROR: bad-index indirect ; + +: check-ESP ( indirect -- indirect ) + dup index>> { ESP RSP } memq? [ bad-index ] when ; : canonicalize ( indirect -- indirect ) #! Modify the indirect to work around certain addressing mode #! quirks. - canonicalize-EBP canonicalize-ESP ; + canonicalize-EBP check-ESP ; : ( base index scale displacement -- indirect ) indirect boa canonicalize ; @@ -91,7 +91,7 @@ M: indirect extended? base>> extended? ; GENERIC: sib-present? ( op -- ? ) M: indirect sib-present? - [ base>> { ESP RSP } member? ] [ index>> ] [ scale>> ] tri or or ; + [ base>> { ESP RSP R12 } member? ] [ index>> ] [ scale>> ] tri or or ; M: register sib-present? drop f ; @@ -254,7 +254,8 @@ M: object operand-64? drop f ; reg-code swap addressing ; : direction-bit ( dst src op -- dst' src' op' ) - pick register? [ BIN: 10 opcode-or swapd ] when ; + pick register? pick register? not and + [ BIN: 10 opcode-or swapd ] when ; : operand-size-bit ( dst src op -- dst' src' op' ) over register-8? [ BIN: 1 opcode-or ] unless ; diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor index 2b85420ee9..9ebfdaaa5a 100644 --- a/basis/io/unix/files/files.factor +++ b/basis/io/unix/files/files.factor @@ -6,7 +6,7 @@ math.bitwise byte-arrays alien combinators calendar io.encodings.binary accessors sequences strings system io.files.private destructors vocabs.loader calendar.unix unix.stat alien.c-types arrays unix.users unix.groups -environment fry io.encodings.utf8 alien.strings ; +environment fry io.encodings.utf8 alien.strings unix.statfs ; IN: io.unix.files M: unix cwd ( -- path ) @@ -142,9 +142,7 @@ os { [ opendir dup [ (io-error) ] unless ] dip dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline -HOOK: find-next-file os ( DIR* -- byte-array ) - -M: unix find-next-file ( DIR* -- byte-array ) +: find-next-file ( DIR* -- byte-array ) "dirent" f [ readdir_r 0 = [ (io-error) ] unless ] 2keep @@ -161,8 +159,6 @@ M: unix (directory-entries) ( path -- seq ) [ drop ] produce ] with-unix-directory ; -os openbsd = [ "io.unix.files.openbsd" require ] when - + "ULARGE_INTEGER" + "ULARGE_INTEGER" + [ GetDiskFreeSpaceEx win32-error=0/f ] 3keep + \ winnt-file-system-info new + swap *ulonglong >>total-free-bytes + swap *ulonglong >>total-bytes + swap *ulonglong >>free-space ; + : file-times ( path -- timestamp timestamp timestamp ) [ normalize-path open-existing &dispose handle>> diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 17eafa91c6..6659940b2b 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -16,13 +16,18 @@ ERROR: vocab-name-contains-dot path ; ERROR: no-vocab vocab ; . ; +: (scaffold-path) ( path string -- path ) + dupd [ file-name ] dip append append-path ; + : scaffold-path ( path string -- path ? ) - dupd [ file-name ] dip append append-path + (scaffold-path) dup exists? [ dup not-scaffolding f ] [ dup scaffolding t ] if ; : scaffold-copyright ( -- ) @@ -205,14 +213,15 @@ ERROR: no-vocab vocab ; : check-vocab ( vocab -- vocab ) dup find-vocab-root [ no-vocab ] unless ; + PRIVATE> : link-vocab ( vocab -- ) check-vocab "Edit documentation: " write - [ find-vocab-root ] keep - [ append-path ] keep "-docs.factor" append append-path - . ; + [ find-vocab-root ] + [ vocab>scaffold-path ] bi + "-docs.factor" (scaffold-path) . ; : help. ( word -- ) [ (help.) ] [ nl vocabulary>> link-vocab ] bi ; diff --git a/basis/unix/stat/linux/32/32.factor b/basis/unix/stat/linux/32/32.factor index 00a6239916..ded06595de 100644 --- a/basis/unix/stat/linux/32/32.factor +++ b/basis/unix/stat/linux/32/32.factor @@ -22,21 +22,8 @@ C-STRUCT: stat { "ulong" "unused4" } { "ulong" "unused5" } ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - FUNCTION: int __xstat ( int ver, char* pathname, stat* buf ) ; FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ; : stat ( pathname buf -- int ) 3 -rot __xstat ; : lstat ( pathname buf -- int ) 3 -rot __lxstat ; - -C-STRUCT: statfs - { "long" "f_type" } - { "long" "f_bsize" } - { "long" "f_blocks" } - { "long" "f_bfree" } - { "long" "f_bavail" } - { "long" "f_files" } - { "long" "f_ffree" } - { "fsid_t" "f_fsid" } - { "long" "f_namelen" } ; diff --git a/basis/unix/stat/linux/64/64.factor b/basis/unix/stat/linux/64/64.factor index b9d48066fb..f406b2ccee 100644 --- a/basis/unix/stat/linux/64/64.factor +++ b/basis/unix/stat/linux/64/64.factor @@ -28,22 +28,3 @@ FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ; : stat ( pathname buf -- int ) 1 -rot __xstat ; : lstat ( pathname buf -- int ) 1 -rot __lxstat ; - -TYPEDEF: ssize_t __SWORD_TYPE -TYPEDEF: ulonglong __fsblkcnt64_t -TYPEDEF: ulonglong __fsfilcnt64_t - -C-STRUCT: statfs64 - { "__SWORD_TYPE" "f_type" } - { "__SWORD_TYPE" "f_bsize" } - { "__fsblkcnt64_t" "f_blocks" } - { "__fsblkcnt64_t" "f_bfree" } - { "__fsblkcnt64_t" "f_bavail" } - { "__fsfilcnt64_t" "f_files" } - { "__fsfilcnt64_t" "f_ffree" } - { "__fsid_t" "f_fsid" } - { "__SWORD_TYPE" "f_namelen" } - { "__SWORD_TYPE" "f_frsize" } - { { "__SWORD_TYPE" 5 } "f_spare" } ; - -FUNCTION: int statfs64 ( char* path, statfs64* buf ) ; diff --git a/basis/unix/stat/macosx/macosx.factor b/basis/unix/stat/macosx/macosx.factor index 49b6709847..2656ec71e1 100644 --- a/basis/unix/stat/macosx/macosx.factor +++ b/basis/unix/stat/macosx/macosx.factor @@ -31,114 +31,3 @@ FUNCTION: int lstat64 ( char* pathname, stat* buf ) ; : stat ( path buf -- n ) stat64 ; : lstat ( path buf -- n ) lstat64 ; - -: MNT_RDONLY HEX: 00000001 ; inline -: MNT_SYNCHRONOUS HEX: 00000002 ; inline -: MNT_NOEXEC HEX: 00000004 ; inline -: MNT_NOSUID HEX: 00000008 ; inline -: MNT_NODEV HEX: 00000010 ; inline -: MNT_UNION HEX: 00000020 ; inline -: MNT_ASYNC HEX: 00000040 ; inline -: MNT_EXPORTED HEX: 00000100 ; inline -: MNT_QUARANTINE HEX: 00000400 ; inline -: MNT_LOCAL HEX: 00001000 ; inline -: MNT_QUOTA HEX: 00002000 ; inline -: MNT_ROOTFS HEX: 00004000 ; inline -: MNT_DOVOLFS HEX: 00008000 ; inline -: MNT_DONTBROWSE HEX: 00100000 ; inline -: MNT_IGNORE_OWNERSHIP HEX: 00200000 ; inline -: MNT_AUTOMOUNTED HEX: 00400000 ; inline -: MNT_JOURNALED HEX: 00800000 ; inline -: MNT_NOUSERXATTR HEX: 01000000 ; inline -: MNT_DEFWRITE HEX: 02000000 ; inline -: MNT_MULTILABEL HEX: 04000000 ; inline -: MNT_NOATIME HEX: 10000000 ; inline -: MNT_UNKNOWNPERMISSIONS MNT_IGNORE_OWNERSHIP ; inline - -: MNT_VISFLAGMASK ( -- n ) - { - MNT_RDONLY MNT_SYNCHRONOUS MNT_NOEXEC - MNT_NOSUID MNT_NODEV MNT_UNION - MNT_ASYNC MNT_EXPORTED MNT_QUARANTINE - MNT_LOCAL MNT_QUOTA - MNT_ROOTFS MNT_DOVOLFS MNT_DONTBROWSE - MNT_IGNORE_OWNERSHIP MNT_AUTOMOUNTED MNT_JOURNALED - MNT_NOUSERXATTR MNT_DEFWRITE MNT_MULTILABEL MNT_NOATIME - } flags ; inline - -: MNT_UPDATE HEX: 00010000 ; inline -: MNT_RELOAD HEX: 00040000 ; inline -: MNT_FORCE HEX: 00080000 ; inline -: MNT_CMDFLAGS { MNT_UPDATE MNT_RELOAD MNT_FORCE } flags ; inline - -: VFS_GENERIC 0 ; inline -: VFS_NUMMNTOPS 1 ; inline -: VFS_MAXTYPENUM 1 ; inline -: VFS_CONF 2 ; inline -: VFS_SET_PACKAGE_EXTS 3 ; inline - -: MNT_WAIT 1 ; inline -: MNT_NOWAIT 2 ; inline - -: VFS_CTL_VERS1 HEX: 01 ; inline - -: VFS_CTL_STATFS HEX: 00010001 ; inline -: VFS_CTL_UMOUNT HEX: 00010002 ; inline -: VFS_CTL_QUERY HEX: 00010003 ; inline -: VFS_CTL_NEWADDR HEX: 00010004 ; inline -: VFS_CTL_TIMEO HEX: 00010005 ; inline -: VFS_CTL_NOLOCKS HEX: 00010006 ; inline - -C-STRUCT: vfsquery - { "uint32_t" "vq_flags" } - { { "uint32_t" 31 } "vq_spare" } ; - -: VQ_NOTRESP HEX: 0001 ; inline -: VQ_NEEDAUTH HEX: 0002 ; inline -: VQ_LOWDISK HEX: 0004 ; inline -: VQ_MOUNT HEX: 0008 ; inline -: VQ_UNMOUNT HEX: 0010 ; inline -: VQ_DEAD HEX: 0020 ; inline -: VQ_ASSIST HEX: 0040 ; inline -: VQ_NOTRESPLOCK HEX: 0080 ; inline -: VQ_UPDATE HEX: 0100 ; inline -: VQ_FLAG0200 HEX: 0200 ; inline -: VQ_FLAG0400 HEX: 0400 ; inline -: VQ_FLAG0800 HEX: 0800 ; inline -: VQ_FLAG1000 HEX: 1000 ; inline -: VQ_FLAG2000 HEX: 2000 ; inline -: VQ_FLAG4000 HEX: 4000 ; inline -: VQ_FLAG8000 HEX: 8000 ; inline - -: NFSV4_MAX_FH_SIZE 128 ; inline -: NFSV3_MAX_FH_SIZE 64 ; inline -: NFSV2_MAX_FH_SIZE 32 ; inline -: NFS_MAX_FH_SIZE NFSV4_MAX_FH_SIZE ; inline - -: MFSNAMELEN 15 ; inline -: MNAMELEN 90 ; inline -: MFSTYPENAMELEN 16 ; inline - -C-STRUCT: fsid_t - { { "int32_t" 2 } "val" } ; - -C-STRUCT: statfs64 - { "uint32_t" "f_bsize" } - { "int32_t" "f_iosize" } - { "uint64_t" "f_blocks" } - { "uint64_t" "f_bfree" } - { "uint64_t" "f_bavail" } - { "uint64_t" "f_files" } - { "uint64_t" "f_ffree" } - { "fsid_t" "f_fsid" } - { "uid_t" "f_owner" } - { "uint32_t" "f_type" } - { "uint32_t" "f_flags" } - { "uint32_t" "f_fssubtype" } - { { "char" MFSTYPENAMELEN } "f_fstypename" } - { { "char" MAXPATHLEN } "f_mntonname" } - { { "char" MAXPATHLEN } "f_mntfromname" } - { { "uint32_t" 8 } "f_reserved" } ; - -FUNCTION: int statfs64 ( char* path, statfs64* buf ) ; -FUNCTION: int getmntinfo64 ( statfs64** mntbufp, int flags ) ; diff --git a/basis/unix/statfs/freebsd/authors.txt b/basis/unix/statfs/freebsd/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/unix/statfs/freebsd/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/freebsd/freebsd.factor b/basis/unix/statfs/freebsd/freebsd.factor new file mode 100644 index 0000000000..6c5a45c4d2 --- /dev/null +++ b/basis/unix/statfs/freebsd/freebsd.factor @@ -0,0 +1,52 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax kernel unix io.files math accessors +combinators system io.backend alien.c-types ; +IN: unix.statfs.freebsd + +: ST_RDONLY 1 ; inline +: ST_NOSUID 2 ; inline + +C-STRUCT: statvfs + { "fsblkcnt_t" "f_bavail" } + { "fsblkcnt_t" "f_bfree" } + { "fsblkcnt_t" "f_blocks" } + { "fsfilcnt_t" "f_favail" } + { "fsfilcnt_t" "f_ffree" } + { "fsfilcnt_t" "f_files" } + { "ulong" "f_bsize" } + { "ulong" "f_flag" } + { "ulong" "f_frsize" } + { "ulong" "f_fsid" } + { "ulong" "f_namemax" } ; + +FUNCTION: int statvfs ( char* path, statvfs* buf ) ; + +TUPLE: freebsd-file-system-info < file-system-info +bavail bfree blocks favail ffree ffiles +bsize flag frsize fsid namemax ; + +M: freebsd >file-system-info ( struct -- statfs ) + [ \ freebsd-file-system-info new ] dip + { + [ + [ statvfs-f_bsize ] + [ statvfs-f_bavail ] bi * >>free-space + ] + [ statvfs-f_bavail >>bavail ] + [ statvfs-f_bfree >>bfree ] + [ statvfs-f_blocks >>blocks ] + [ statvfs-f_favail >>favail ] + [ statvfs-f_ffree >>ffree ] + [ statvfs-f_files >>files ] + [ statvfs-f_bsize >>bsize ] + [ statvfs-f_flag >>flag ] + [ statvfs-f_frsize >>frsize ] + [ statvfs-f_fsid >>fsid ] + [ statvfs-f_namemax >>namemax ] + } cleave ; + +M: freebsd file-system-info ( path -- byte-array ) + normalize-path + "statvfs" tuck statvfs io-error + >file-system-info ; diff --git a/basis/io/unix/files/openbsd/tags.txt b/basis/unix/statfs/freebsd/tags.txt similarity index 100% rename from basis/io/unix/files/openbsd/tags.txt rename to basis/unix/statfs/freebsd/tags.txt diff --git a/basis/unix/statfs/linux/32/32.factor b/basis/unix/statfs/linux/32/32.factor new file mode 100644 index 0000000000..c6ec0bc658 --- /dev/null +++ b/basis/unix/statfs/linux/32/32.factor @@ -0,0 +1,46 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types combinators kernel io.files unix.stat +math accessors system unix io.backend layouts vocabs.loader +alien.syntax ; +IN: unix.statfs.linux + +C-STRUCT: statfs + { "long" "f_type" } + { "long" "f_bsize" } + { "long" "f_blocks" } + { "long" "f_bfree" } + { "long" "f_bavail" } + { "long" "f_files" } + { "long" "f_ffree" } + { "fsid_t" "f_fsid" } + { "long" "f_namelen" } ; + +FUNCTION: int statfs ( char* path, statfs* buf ) ; + +TUPLE: linux32-file-system-info < file-system-info +type bsize blocks bfree bavail files ffree fsid +namelen frsize spare ; + +M: linux >file-system-info ( struct -- statfs ) + [ \ linux32-file-system-info new ] dip + { + [ + [ statfs-f_bsize ] + [ statfs-f_bavail ] bi * >>free-space + ] + [ statfs-f_type >>type ] + [ statfs-f_bsize >>bsize ] + [ statfs-f_blocks >>blocks ] + [ statfs-f_bfree >>bfree ] + [ statfs-f_bavail >>bavail ] + [ statfs-f_files >>files ] + [ statfs-f_ffree >>ffree ] + [ statfs-f_fsid >>fsid ] + [ statfs-f_namelen >>namelen ] + } cleave ; + +M: linux file-system-info ( path -- byte-array ) + normalize-path + "statfs" tuck statfs io-error + >file-system-info ; diff --git a/basis/unix/statfs/linux/32/authors.txt b/basis/unix/statfs/linux/32/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/unix/statfs/linux/32/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/linux/32/tags.txt b/basis/unix/statfs/linux/32/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/statfs/linux/32/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/unix/statfs/linux/64/64.factor b/basis/unix/statfs/linux/64/64.factor new file mode 100644 index 0000000000..a84bec0486 --- /dev/null +++ b/basis/unix/statfs/linux/64/64.factor @@ -0,0 +1,50 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types combinators kernel io.files unix.stat +math accessors system unix io.backend layouts vocabs.loader +alien.syntax ; +IN: unix.statfs.linux + +C-STRUCT: statfs64 + { "__SWORD_TYPE" "f_type" } + { "__SWORD_TYPE" "f_bsize" } + { "__fsblkcnt64_t" "f_blocks" } + { "__fsblkcnt64_t" "f_bfree" } + { "__fsblkcnt64_t" "f_bavail" } + { "__fsfilcnt64_t" "f_files" } + { "__fsfilcnt64_t" "f_ffree" } + { "__fsid_t" "f_fsid" } + { "__SWORD_TYPE" "f_namelen" } + { "__SWORD_TYPE" "f_frsize" } + { { "__SWORD_TYPE" 5 } "f_spare" } ; + +FUNCTION: int statfs64 ( char* path, statfs64* buf ) ; + +TUPLE: linux64-file-system-info < file-system-info +type bsize blocks bfree bavail files ffree fsid +namelen frsize spare ; + +M: linux >file-system-info ( struct -- statfs ) + [ \ linux64-file-system-info new ] dip + { + [ + [ statfs64-f_bsize ] + [ statfs64-f_bavail ] bi * >>free-space + ] + [ statfs64-f_type >>type ] + [ statfs64-f_bsize >>bsize ] + [ statfs64-f_blocks >>blocks ] + [ statfs64-f_bfree >>bfree ] + [ statfs64-f_bavail >>bavail ] + [ statfs64-f_files >>files ] + [ statfs64-f_ffree >>ffree ] + [ statfs64-f_fsid >>fsid ] + [ statfs64-f_namelen >>namelen ] + [ statfs64-f_frsize >>frsize ] + [ statfs64-f_spare >>spare ] + } cleave ; + +M: linux file-system-info ( path -- byte-array ) + normalize-path + "statfs64" tuck statfs64 io-error + >file-system-info ; diff --git a/basis/unix/statfs/linux/64/authors.txt b/basis/unix/statfs/linux/64/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/unix/statfs/linux/64/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/linux/64/tags.txt b/basis/unix/statfs/linux/64/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/statfs/linux/64/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/unix/statfs/linux/linux-tests.factor b/basis/unix/statfs/linux/linux-tests.factor deleted file mode 100644 index 549905f081..0000000000 --- a/basis/unix/statfs/linux/linux-tests.factor +++ /dev/null @@ -1,4 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: tools.test unix.statfs.linux ; -IN: unix.statfs.linux.tests diff --git a/basis/unix/statfs/linux/linux.factor b/basis/unix/statfs/linux/linux.factor index 44c32fd53d..b4413fba15 100644 --- a/basis/unix/statfs/linux/linux.factor +++ b/basis/unix/statfs/linux/linux.factor @@ -1,34 +1,10 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types combinators kernel io.files unix.stat -math accessors system unix io.backend ; +math accessors system unix io.backend layouts vocabs.loader ; IN: unix.statfs.linux -TUPLE: linux-file-system-info < file-system-info -type bsize blocks bfree bavail files ffree fsid -namelen frsize spare ; - -: statfs>file-system-info ( struct -- statfs ) - [ \ linux-file-system-info new ] dip - { - [ - [ statfs64-f_bsize ] - [ statfs64-f_bavail ] bi * >>free-space - ] - [ statfs64-f_type >>type ] - [ statfs64-f_bsize >>bsize ] - [ statfs64-f_blocks >>blocks ] - [ statfs64-f_bfree >>bfree ] - [ statfs64-f_bavail >>bavail ] - [ statfs64-f_files >>files ] - [ statfs64-f_ffree >>ffree ] - [ statfs64-f_fsid >>fsid ] - [ statfs64-f_namelen >>namelen ] - [ statfs64-f_frsize >>frsize ] - [ statfs64-f_spare >>spare ] - } cleave ; - -M: linux file-system-info ( path -- byte-array ) - normalize-path - "statfs64" tuck statfs64 io-error - statfs>file-system-info ; +cell-bits { + { 32 [ "unix.statfs.linux.32" require ] } + { 64 [ "unix.statfs.linux.64" require ] } +} case diff --git a/basis/unix/statfs/macosx/macosx-tests.factor b/basis/unix/statfs/macosx/macosx-tests.factor deleted file mode 100644 index 35625e2198..0000000000 --- a/basis/unix/statfs/macosx/macosx-tests.factor +++ /dev/null @@ -1,4 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: tools.test unix.statfs.macosx ; -IN: unix.statfs.macosx.tests diff --git a/basis/unix/statfs/macosx/macosx.factor b/basis/unix/statfs/macosx/macosx.factor index 60fb1658c5..4bd9f55132 100644 --- a/basis/unix/statfs/macosx/macosx.factor +++ b/basis/unix/statfs/macosx/macosx.factor @@ -2,9 +2,122 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types io.encodings.utf8 io.encodings.string kernel sequences unix.stat accessors unix combinators math -grouping system unix.statfs io.files io.backend alien.strings ; +grouping system unix.statfs io.files io.backend alien.strings +math.bitwise alien.syntax ; IN: unix.statfs.macosx +: MNT_RDONLY HEX: 00000001 ; inline +: MNT_SYNCHRONOUS HEX: 00000002 ; inline +: MNT_NOEXEC HEX: 00000004 ; inline +: MNT_NOSUID HEX: 00000008 ; inline +: MNT_NODEV HEX: 00000010 ; inline +: MNT_UNION HEX: 00000020 ; inline +: MNT_ASYNC HEX: 00000040 ; inline +: MNT_EXPORTED HEX: 00000100 ; inline +: MNT_QUARANTINE HEX: 00000400 ; inline +: MNT_LOCAL HEX: 00001000 ; inline +: MNT_QUOTA HEX: 00002000 ; inline +: MNT_ROOTFS HEX: 00004000 ; inline +: MNT_DOVOLFS HEX: 00008000 ; inline +: MNT_DONTBROWSE HEX: 00100000 ; inline +: MNT_IGNORE_OWNERSHIP HEX: 00200000 ; inline +: MNT_AUTOMOUNTED HEX: 00400000 ; inline +: MNT_JOURNALED HEX: 00800000 ; inline +: MNT_NOUSERXATTR HEX: 01000000 ; inline +: MNT_DEFWRITE HEX: 02000000 ; inline +: MNT_MULTILABEL HEX: 04000000 ; inline +: MNT_NOATIME HEX: 10000000 ; inline +: MNT_UNKNOWNPERMISSIONS MNT_IGNORE_OWNERSHIP ; inline + +: MNT_VISFLAGMASK ( -- n ) + { + MNT_RDONLY MNT_SYNCHRONOUS MNT_NOEXEC + MNT_NOSUID MNT_NODEV MNT_UNION + MNT_ASYNC MNT_EXPORTED MNT_QUARANTINE + MNT_LOCAL MNT_QUOTA + MNT_ROOTFS MNT_DOVOLFS MNT_DONTBROWSE + MNT_IGNORE_OWNERSHIP MNT_AUTOMOUNTED MNT_JOURNALED + MNT_NOUSERXATTR MNT_DEFWRITE MNT_MULTILABEL MNT_NOATIME + } flags ; inline + +: MNT_UPDATE HEX: 00010000 ; inline +: MNT_RELOAD HEX: 00040000 ; inline +: MNT_FORCE HEX: 00080000 ; inline +: MNT_CMDFLAGS { MNT_UPDATE MNT_RELOAD MNT_FORCE } flags ; inline + +: VFS_GENERIC 0 ; inline +: VFS_NUMMNTOPS 1 ; inline +: VFS_MAXTYPENUM 1 ; inline +: VFS_CONF 2 ; inline +: VFS_SET_PACKAGE_EXTS 3 ; inline + +: MNT_WAIT 1 ; inline +: MNT_NOWAIT 2 ; inline + +: VFS_CTL_VERS1 HEX: 01 ; inline + +: VFS_CTL_STATFS HEX: 00010001 ; inline +: VFS_CTL_UMOUNT HEX: 00010002 ; inline +: VFS_CTL_QUERY HEX: 00010003 ; inline +: VFS_CTL_NEWADDR HEX: 00010004 ; inline +: VFS_CTL_TIMEO HEX: 00010005 ; inline +: VFS_CTL_NOLOCKS HEX: 00010006 ; inline + +C-STRUCT: vfsquery + { "uint32_t" "vq_flags" } + { { "uint32_t" 31 } "vq_spare" } ; + +: VQ_NOTRESP HEX: 0001 ; inline +: VQ_NEEDAUTH HEX: 0002 ; inline +: VQ_LOWDISK HEX: 0004 ; inline +: VQ_MOUNT HEX: 0008 ; inline +: VQ_UNMOUNT HEX: 0010 ; inline +: VQ_DEAD HEX: 0020 ; inline +: VQ_ASSIST HEX: 0040 ; inline +: VQ_NOTRESPLOCK HEX: 0080 ; inline +: VQ_UPDATE HEX: 0100 ; inline +: VQ_FLAG0200 HEX: 0200 ; inline +: VQ_FLAG0400 HEX: 0400 ; inline +: VQ_FLAG0800 HEX: 0800 ; inline +: VQ_FLAG1000 HEX: 1000 ; inline +: VQ_FLAG2000 HEX: 2000 ; inline +: VQ_FLAG4000 HEX: 4000 ; inline +: VQ_FLAG8000 HEX: 8000 ; inline + +: NFSV4_MAX_FH_SIZE 128 ; inline +: NFSV3_MAX_FH_SIZE 64 ; inline +: NFSV2_MAX_FH_SIZE 32 ; inline +: NFS_MAX_FH_SIZE NFSV4_MAX_FH_SIZE ; inline + +: MFSNAMELEN 15 ; inline +: MNAMELEN 90 ; inline +: MFSTYPENAMELEN 16 ; inline + +C-STRUCT: fsid_t + { { "int32_t" 2 } "val" } ; + +C-STRUCT: statfs64 + { "uint32_t" "f_bsize" } + { "int32_t" "f_iosize" } + { "uint64_t" "f_blocks" } + { "uint64_t" "f_bfree" } + { "uint64_t" "f_bavail" } + { "uint64_t" "f_files" } + { "uint64_t" "f_ffree" } + { "fsid_t" "f_fsid" } + { "uid_t" "f_owner" } + { "uint32_t" "f_type" } + { "uint32_t" "f_flags" } + { "uint32_t" "f_fssubtype" } + { { "char" MFSTYPENAMELEN } "f_fstypename" } + { { "char" MAXPATHLEN } "f_mntonname" } + { { "char" MAXPATHLEN } "f_mntfromname" } + { { "uint32_t" 8 } "f_reserved" } ; + +FUNCTION: int statfs64 ( char* path, statfs64* buf ) ; +FUNCTION: int getmntinfo64 ( statfs64** mntbufp, int flags ) ; + + TUPLE: macosx-file-system-info < file-system-info block-size io-size blocks blocks-free blocks-available files files-free file-system-id owner type flags filesystem-subtype @@ -15,7 +128,7 @@ M: macosx mounted* ( -- array ) [ *void* ] dip "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 { [ @@ -49,4 +162,4 @@ M: macosx mounted* ( -- array ) M: macosx file-system-info ( path -- file-system-info ) normalize-path "statfs64" tuck statfs64 io-error - statfs64>file-system-info ; + >file-system-info ; diff --git a/basis/unix/statfs/netbsd/netbsd.factor b/basis/unix/statfs/netbsd/netbsd.factor index c58d6e1a0d..dd1ccd4c9a 100644 --- a/basis/unix/statfs/netbsd/netbsd.factor +++ b/basis/unix/statfs/netbsd/netbsd.factor @@ -2,7 +2,7 @@ ! 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 ; +io.encodings.utf8 alien.strings unix.types ; IN: unix.statfs.netbsd : _VFS_NAMELEN 32 ; inline @@ -34,6 +34,8 @@ C-STRUCT: statvfs { { "char" _VFS_NAMELEN } "f_mntonname" } { { "char" _VFS_NAMELEN } "f_mntfromname" } ; +FUNCTION: int statvfs ( char* path, statvfs *buf ) ; + TUPLE: netbsd-file-system-info < file-system-info flag bsize frsize io-size blocks blocks-free blocks-available blocks-reserved @@ -41,7 +43,7 @@ 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 ) +M: netbsd >file-system-info ( byte-array -- netbsd-file-system-info ) [ \ netbsd-file-system-info new ] dip { [ @@ -73,4 +75,4 @@ file-system-type-name mount-from ; M: netbsd file-system-info normalize-path "statvfs" tuck statvfs io-error - statvfs>file-system-info ; + >file-system-info ; diff --git a/basis/unix/statfs/openbsd/32/32.factor b/basis/unix/statfs/openbsd/32/32.factor new file mode 100644 index 0000000000..aa1e8425dc --- /dev/null +++ b/basis/unix/statfs/openbsd/32/32.factor @@ -0,0 +1,26 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax kernel unix ; +IN: unix.statfs.openbsd.32 + +: MFSNAMELEN 16 ; inline +: MNAMELEN 90 ; inline + +C-STRUCT: statfs + { "u_int32_t" "f_flags" } + { "int32_t" "f_bsize" } + { "u_int32_t" "f_iosize" } + { "u_int32_t" "f_blocks" } + { "u_int32_t" "f_bfree" } + { "int32_t" "f_bavail" } + { "u_int32_t" "f_files" } + { "u_int32_t" "f_ffree" } + { "fsid_t" "f_fsid" } + { "uid_t" "f_owner" } + { "u_int32_t" "f_syncwrites" } + { "u_int32_t" "f_asyncwrites" } + { "u_int32_t" "f_ctime" } + { { "u_int32_t" 3 } "f_spare" } + { { "char" MFSNAMELEN } "f_fstypename" } + { { "char" MNAMELEN } "f_mntonname" } + { { "char" MNAMELEN } "f_mntfromname" } ; diff --git a/basis/unix/statfs/openbsd/32/authors.txt b/basis/unix/statfs/openbsd/32/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/unix/statfs/openbsd/32/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/openbsd/32/tags.txt b/basis/unix/statfs/openbsd/32/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/statfs/openbsd/32/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/unix/statfs/openbsd/64/64.factor b/basis/unix/statfs/openbsd/64/64.factor new file mode 100644 index 0000000000..fd40fba033 --- /dev/null +++ b/basis/unix/statfs/openbsd/64/64.factor @@ -0,0 +1,32 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax unix ; +IN: unix.statfs.openbsd.64 + +: MFSNAMELEN 16 ; inline +: MNAMELEN 90 ; inline + +C-STRUCT: statfss + { "u_int32_t" "f_flags" } + { "u_int32_t" "f_bsize" } + { "u_int32_t" "f_iosize" } + { "u_int64_t" "f_blocks" } + { "u_int64_t" "f_bfree" } + { "int64_t" "f_bavail" } + { "u_int64_t" "f_files" } + { "u_int64_t" "f_ffree" } + { "int64_t" "f_favail" } + { "u_int64_t" "f_syncwrites" } + { "u_int64_t" "f_syncreads" } + { "u_int64_t" "f_asyncwrites" } + { "u_int64_t" "f_asyncreads" } + { "fsid_t" "f_fsid" } + { "u_int32_t" "f_namemax" } + { "uid_t" "f_owner" } + { "u_int32_t" "f_ctime" } + { { "u_int32_t" 3 } " f_spare" } + { { "char" MFSNAMELEN } "f_fstypename" } + { { "char" MNAMELEN } "f_mntonname" } + { { "char" MNAMELEN } "f_mntfromname" } + { { "char" 512 } "mount_info" } ; + ! { "mount_info" "mount_info" } ; diff --git a/basis/unix/statfs/openbsd/64/authors.txt b/basis/unix/statfs/openbsd/64/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/unix/statfs/openbsd/64/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/openbsd/64/tags.txt b/basis/unix/statfs/openbsd/64/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/statfs/openbsd/64/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/unix/statfs/openbsd/authors.txt b/basis/unix/statfs/openbsd/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/unix/statfs/openbsd/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/openbsd/openbsd.factor b/basis/unix/statfs/openbsd/openbsd.factor new file mode 100644 index 0000000000..a64b60a078 --- /dev/null +++ b/basis/unix/statfs/openbsd/openbsd.factor @@ -0,0 +1,52 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax accessors combinators kernel io.files +unix.types math system io.backend alien.c-types unix ; +IN: unix.statfs.openbsd + +C-STRUCT: statvfs + { "ulong" "f_bsize" } + { "ulong" "f_frsize" } + { "fsblkcnt_t" "f_blocks" } + { "fsblkcnt_t" "f_bfree" } + { "fsblkcnt_t" "f_bavail" } + { "fsfilcnt_t" "f_files" } + { "fsfilcnt_t" "f_ffree" } + { "fsfilcnt_t" "f_favail" } + { "ulong" "f_fsid" } + { "ulong" "f_flag" } + { "ulong" "f_namemax" } ; + +: ST_RDONLY 1 ; inline +: ST_NOSUID 2 ; inline + +FUNCTION: int statvfs ( char* path, statvfs* buf ) ; + +TUPLE: openbsd-file-system-info < file-system-info +bsize frsize blocks bfree bavail files ffree favail +fsid flag namemax ; + +M: openbsd >file-system-info ( struct -- statfs ) + [ \ openbsd-file-system-info new ] dip + { + [ + [ statvfs-f_bsize ] + [ statvfs-f_bavail ] bi * >>free-space + ] + [ statvfs-f_bsize >>bsize ] + [ statvfs-f_frsize >>frsize ] + [ statvfs-f_blocks >>blocks ] + [ statvfs-f_bfree >>bfree ] + [ statvfs-f_bavail >>bavail ] + [ statvfs-f_files >>files ] + [ statvfs-f_ffree >>ffree ] + [ statvfs-f_favail >>favail ] + [ statvfs-f_fsid >>fsid ] + [ statvfs-f_flag >>flag ] + [ statvfs-f_namemax >>namemax ] + } cleave ; + +M: openbsd file-system-info ( path -- byte-array ) + normalize-path + "statvfs" tuck statvfs io-error + >file-system-info ; diff --git a/basis/unix/statfs/openbsd/tags.txt b/basis/unix/statfs/openbsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/statfs/openbsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/unix/statfs/statfs.factor b/basis/unix/statfs/statfs.factor index 0d99b57faf..8ac5a46883 100644 --- a/basis/unix/statfs/statfs.factor +++ b/basis/unix/statfs/statfs.factor @@ -25,7 +25,7 @@ TUPLE: file-system-info root-directory total-free-size total-size ; os { { linux [ "unix.statfs.linux" require ] } { macosx [ "unix.statfs.macosx" require ] } - ! { freebsd [ "unix.statfs.freebsd" require ] } - ! { netbsd [ "unix.statfs.netbsd" require ] } - ! { openbsd [ "unix.statfs.openbsd" require ] } + { freebsd [ "unix.statfs.freebsd" require ] } + { netbsd [ "unix.statfs.netbsd" require ] } + { openbsd [ "unix.statfs.openbsd" require ] } } case diff --git a/basis/unix/types/linux/linux.factor b/basis/unix/types/linux/linux.factor index f32d8a23c4..bf5d4b7f1d 100644 --- a/basis/unix/types/linux/linux.factor +++ b/basis/unix/types/linux/linux.factor @@ -23,3 +23,7 @@ TYPEDEF: __slongword_type blkcnt_t TYPEDEF: __sword_type ssize_t TYPEDEF: __s32_type pid_t TYPEDEF: __slongword_type time_t + +TYPEDEF: ssize_t __SWORD_TYPE +TYPEDEF: ulonglong __fsblkcnt64_t +TYPEDEF: ulonglong __fsfilcnt64_t diff --git a/basis/unix/types/netbsd/netbsd.factor b/basis/unix/types/netbsd/netbsd.factor index d69d498704..b5b0ffe661 100644 --- a/basis/unix/types/netbsd/netbsd.factor +++ b/basis/unix/types/netbsd/netbsd.factor @@ -17,12 +17,6 @@ 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/basis/unix/types/types.factor b/basis/unix/types/types.factor index 968b234b9f..51db6f5da0 100644 --- a/basis/unix/types/types.factor +++ b/basis/unix/types/types.factor @@ -6,6 +6,11 @@ TYPEDEF: void* caddr_t TYPEDEF: uint in_addr_t TYPEDEF: uint socklen_t +TYPEDEF: __uint64_t fsblkcnt_t +TYPEDEF: fsblkcnt_t __fsblkcnt_t +TYPEDEF: __uint64_t fsfilcnt_t +TYPEDEF: fsfilcnt_t __fsfilcnt_t + TYPEDEF: char int8_t TYPEDEF: short int16_t TYPEDEF: int int32_t diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index f19561cda3..dfac6a5236 100644 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -928,7 +928,8 @@ FUNCTION: HANDLE GetCurrentThread ( ) ; ! FUNCTION: GetDevicePowerState ! FUNCTION: GetDiskFreeSpaceA ! FUNCTION: GetDiskFreeSpaceExA -! FUNCTION: GetDiskFreeSpaceExW +FUNCTION: BOOL GetDiskFreeSpaceExW ( LPCTSTR lpDirectoryName, PULARGE_INTEGER pFreeBytesAvailable, PULARGE_INTEGER lpTotalNumberOfBytes, PULARGE_INTEGER lpTotalNumberOfFreeBytes ) ; +ALIAS: GetDiskFreeSpaceEx GetDiskFreeSpaceExW ! FUNCTION: GetDiskFreeSpaceW ! FUNCTION: GetDllDirectoryA ! FUNCTION: GetDllDirectoryW diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor index b1d8914be9..0ac8409016 100644 --- a/basis/windows/types/types.factor +++ b/basis/windows/types/types.factor @@ -62,7 +62,9 @@ TYPEDEF: ulonglong ULONGLONG TYPEDEF: longlong LONG64 TYPEDEF: ulonglong DWORD64 TYPEDEF: longlong LARGE_INTEGER +TYPEDEF: ulonglong ULARGE_INTEGER TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER +TYPEDEF: ULARGE_INTEGER* PULARGE_INTEGER TYPEDEF: wchar_t* LPCSTR TYPEDEF: wchar_t* LPWSTR diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index 984598688d..9a85688202 100644 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -81,6 +81,7 @@ ARTICLE: "fs-meta" "File metadata" { $subsection link-info } { $subsection exists? } { $subsection directory? } + "File types:" { $subsection "file-types" } ; @@ -322,6 +323,12 @@ HELP: with-directory-files { $values { "path" "a pathname string" } { "quot" quotation } } { $description "Calls the quotation with the directory file names on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ; +HELP: file-system-info +{ $values +{ "path" "a pathname string" } +{ "file-system-info" file-system-info } } +{ $description "Returns a platform-specific object describing the file-system that contains the path. The cross-platform slot is " { $slot "free-space" } "." } ; + HELP: resource-path { $values { "path" "a pathname string" } { "newpath" "a pathname string" } } { $description "Resolve a path relative to the Factor source code location." } ; diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 1f6a48b50e..cfb90d58a5 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -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 ( struct -- statfs ) + + hex write "h" write nl ; +: write-header ( len -- ) + "Length: " write + [ unparse write ", " write ] + [ >hex write "h" write nl ] bi ; -: offset. ( lineno -- ) +: write-offset ( lineno -- ) 16 * >hex 8 CHAR: 0 pad-left write "h: " write ; -: h-pad. ( digit -- ) +: write-hex-digit ( digit -- ) >hex 2 CHAR: 0 pad-left write ; -: line. ( str n -- ) - offset. - dup [ h-pad. " " write ] each +: write-hex-line ( str n -- ) + write-offset + dup [ write-hex-digit bl ] each 16 over length - 3 * CHAR: \s write [ dup printable? [ drop CHAR: . ] unless write1 ] each nl ; PRIVATE> -: hexdump ( sequence -- string ) +: hexdump ( seq -- str ) [ - dup length header. - 16 [ line. ] each-index + [ length write-header ] + [ 16 [ write-hex-line ] each-index ] bi ] with-string-writer ; -: hexdump. ( sequence -- ) - hexdump write ; +: hexdump. ( seq -- ) hexdump write ; diff --git a/extra/math/floating-point/authors.txt b/extra/math/floating-point/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/math/floating-point/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/unix/statfs/netbsd/netbsd-tests.factor b/extra/math/floating-point/floating-point-tests.factor similarity index 56% rename from basis/unix/statfs/netbsd/netbsd-tests.factor rename to extra/math/floating-point/floating-point-tests.factor index be100c1cb6..2a60d30d02 100644 --- a/basis/unix/statfs/netbsd/netbsd-tests.factor +++ b/extra/math/floating-point/floating-point-tests.factor @@ -1,4 +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 +USING: tools.test math.floating-point ; +IN: math.floating-point.tests diff --git a/extra/math/floating-point/floating-point.factor b/extra/math/floating-point/floating-point.factor new file mode 100644 index 0000000000..87767181cd --- /dev/null +++ b/extra/math/floating-point/floating-point.factor @@ -0,0 +1,32 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math sequences ; +IN: math.floating-point + +: float-sign ( float -- ? ) + float>bits -31 shift { 1 -1 } nth ; + +: double-sign ( float -- ? ) + double>bits -63 shift { 1 -1 } nth ; + +: float-exponent-bits ( float -- n ) + float>bits -23 shift 8 2^ 1- bitand ; + +: double-exponent-bits ( double -- n ) + double>bits -52 shift 11 2^ 1- bitand ; + +: float-mantissa-bits ( float -- n ) + float>bits 23 2^ 1- bitand ; + +: double-mantissa-bits ( double -- n ) + double>bits 52 2^ 1- bitand ; + +: float-e ( -- float ) 127 ; inline +: double-e ( -- float ) 1023 ; inline + +! : calculate-float ( S M E -- float ) + ! float-e - 2^ * * ; ! bits>float ; + +! : calculate-double ( S M E -- frac ) + ! double-e - 2^ swap 52 2^ /f 1+ * * ; + diff --git a/extra/roman/roman-docs.factor b/extra/roman/roman-docs.factor index a62e92ce08..87551635f1 100644 --- a/extra/roman/roman-docs.factor +++ b/extra/roman/roman-docs.factor @@ -43,3 +43,6 @@ HELP: roman/mod { $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } { "str4" "a string" } } { $description "Computes the quotient and remainder of two Roman numerals." } { $see-also roman* roman/i /mod } ; + +HELP: ROMAN: +{ $description "A parsing word that reads the next token and converts it to an integer." } ; diff --git a/extra/roman/roman-tests.factor b/extra/roman/roman-tests.factor index a15dcef354..82084e0b1f 100644 --- a/extra/roman/roman-tests.factor +++ b/extra/roman/roman-tests.factor @@ -36,3 +36,5 @@ USING: arrays kernel math roman roman.private sequences tools.test ; [ "i" ] [ "iii" "ii" roman/i ] unit-test [ "i" "ii" ] [ "v" "iii" roman/mod ] unit-test [ "iii" "iii" roman- ] must-fail + +[ 30 ] [ ROMAN: xxx ] unit-test diff --git a/extra/roman/roman.factor b/extra/roman/roman.factor index dcadb865f9..5ffdf67753 100644 --- a/extra/roman/roman.factor +++ b/extra/roman/roman.factor @@ -2,10 +2,11 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs kernel math math.order math.vectors namespaces make quotations sequences sequences.lib -sequences.private strings unicode.case ; +sequences.private strings unicode.case lexer parser ; IN: roman : >roman ( n -- str ) @@ -49,11 +51,13 @@ PRIVATE> ] map sum ; ( str1 str2 -- m n ) [ roman> ] bi@ ; : binary-roman-op ( str1 str2 quot -- str3 ) >r 2roman> r> call >roman ; inline + PRIVATE> : roman+ ( str1 str2 -- str3 ) @@ -70,3 +74,5 @@ PRIVATE> : roman/mod ( str1 str2 -- str3 str4 ) [ /mod ] binary-roman-op >r >roman r> ; + +: ROMAN: scan roman> parsed ; parsing